comparing ea281866e560dbaa8e12ed11b1fd03f0c602e354 and main on anil.recoil.org/ocaml-gpx

+35 -4

.tangled/workflows/build.yml

···

       4
       4
        
       

     

       5
       5
        
       dependencies:

     

       6
       6
        
         nixpkgs:

     

       7
       7
       -
           - dune

     

       8
       8
       -
           - ocamlPackages.xmlm

     

       7
       7
       +
           - shell

     

       8
       8
       +
           - stdenv

     

       9
       9
       +
           - findutils

     

       10
       10
       +
           - binutils

     

       11
       11
       +
           - libunwind

     

       12
       12
       +
           - ncurses

     

       13
       13
       +
           - opam

     

       14
       14
       +
           - git

     

       15
       15
       +
           - gawk

     

       16
       16
       +
           - gnupatch

     

       17
       17
       +
           - gnum4

     

       18
       18
       +
           - gnumake

     

       19
       19
       +
           - gnutar

     

       20
       20
       +
           - gnused

     

       21
       21
       +
           - gnugrep

     

       22
       22
       +
           - diffutils

     

       23
       23
       +
           - gzip

     

       24
       24
       +
           - bzip2

     

       25
       25
       +
           - gcc

     

       26
       26
       +
           - ocaml

     

       9
       27
        
       

     

       10
       28
        
       steps:

     

       11
       11
       -
         - name: dune

     

       29
       29
       +
         - name: opam

     

       30
       30
       +
           command: |

     

       31
       31
       +
              opam init --disable-sandboxing -any

     

       32
       32
       +
         - name: switch

     

       33
       33
       +
           command: |

     

       34
       34
       +
              opam install . --confirm-level=unsafe-yes --deps-only

     

       35
       35
       +
         - name: build

     

       36
       36
       +
           command: |

     

       37
       37
       +
              opam exec -- dune build --verbose

     

       38
       38
       +
         - name: test

     

       39
       39
       +
           command: |

     

       40
       40
       +
              opam exec -- dune runtest --verbose

     

       41
       41
       +
         - name: doc

     

       12
       42
        
           command: |

     

       13
       13
       -
              dune build

     

       43
       43
       +
              opam install -y odoc

     

       44
       44
       +
              opam exec -- dune build @doc

CHANGES.md

···

       1
       1
       +
       # v1.0.0

     

       2
       2
       +
       

     

       3
       3
       +
       - Initial public release

+6 -2

CLAUDE.md

···

       1
       1
       -
       My goal is to build a high quality GPX (GPS Exchange Format) in OCaml, using the xmlm streaming code library to make the core library portable. Then build a Unix-based layer over that to implement the IO.

     

       1
       1
       +
       My goal is to build a high quality GPX (GPS Exchange Format) in OCaml, using

     

       2
       2
       +
       the xmlm streaming code library to make the core library portable. Then build a

     

       3
       3
       +
       Unix-based layer over that to implement the IO.

     

       2
       4
        
       

     

       3
       3
       -
       The GPX homepage is at https://www.topografix.com/gpx.asp with the XSD scheme at https://www.topografix.com/GPX/1/1/gpx.xsd and the docs at https://www.topografix.com/GPX/1/1/

     

       5
       5
       +
       The GPX homepage is at https://www.topografix.com/gpx.asp with the XSD scheme

     

       6
       6
       +
       at https://www.topografix.com/GPX/1/1/gpx.xsd and the docs at

     

       7
       7
       +
       https://www.topografix.com/GPX/1/1/

     

       4
       8
        
       

     

       5
       9

+18

LICENSE.md

···

       1
       1
       +
       (*

     

       2
       2
       +
        * ISC License

     

       3
       3
       +
        * 

     

       4
       4
       +
        * Copyright (c) 2025 Anil Madhavapeddy <anil@recoil.org>

     

       5
       5
       +
        *

     

       6
       6
       +
        * Permission to use, copy, modify, and distribute this software for any

     

       7
       7
       +
        * purpose with or without fee is hereby granted, provided that the above

     

       8
       8
       +
        * copyright notice and this permission notice appear in all copies.

     

       9
       9
       +
        *

     

       10
       10
       +
        * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES

     

       11
       11
       +
        * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF

     

       12
       12
       +
        * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR

     

       13
       13
       +
        * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES

     

       14
       14
       +
        * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN

     

       15
       15
       +
        * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF

     

       16
       16
       +
        * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.

     

       17
       17
       +
        *

     

       18
       18
       +
        *)

+57 -57

README.md

···

       1
       1
       -
       # mlgpx - OCaml GPX Library

     

       1
       1
       +
       # mlgpx - an OCaml GPS Exchange Format (GPX) Library

     

       2
       2
        
       

     

       3
       3
        
       An OCaml library for parsing and generating GPX (GPS Exchange Format) 1.0 and

     

       4
       4
        
       1.1 files, and a CLI for common manipulation and query options.

     

       5
       5
        
       

     

       6
       6
       +
       ## Command Line Usage

     

       7
       7
       +
       

     

       8
       8
       +
       The `mlgpx` CLI provides tools for manipulating GPX files from the command line.

     

       9
       9
       +
       

     

       10
       10
       +
       ### Installation

     

       11
       11
       +
       

     

       12
       12
       +
       ```bash

     

       13
       13
       +
       # Install from source

     

       14
       14
       +
       dune build @install

     

       15
       15
       +
       dune install

     

       16
       16
       +
       

     

       17
       17
       +
       # Or use opam

     

       18
       18
       +
       opam install mlgpx

     

       19
       19
       +
       ```

     

       20
       20
       +
       

     

       21
       21
       +
       ### Convert Waypoints to Track

     

       22
       22
       +
       

     

       23
       23
       +
       ```bash

     

       24
       24
       +
       # Basic conversion

     

       25
       25
       +
       mlgpx convert waypoints.gpx track.gpx

     

       26
       26
       +
       

     

       27
       27
       +
       # With custom track name

     

       28
       28
       +
       mlgpx convert --name "My Route" waypoints.gpx route.gpx

     

       29
       29
       +
       

     

       30
       30
       +
       # Sort waypoints by timestamp before conversion

     

       31
       31
       +
       mlgpx convert --sort-time waypoints.gpx sorted_track.gpx

     

       32
       32
       +
       

     

       33
       33
       +
       # Sort by name and preserve original waypoints

     

       34
       34
       +
       mlgpx convert --sort-name --preserve waypoints.gpx mixed.gpx

     

       35
       35
       +
       

     

       36
       36
       +
       # Verbose output with description

     

       37
       37
       +
       mlgpx convert --verbose --desc "Generated route" waypoints.gpx track.gpx

     

       38
       38
       +
       ```

     

       39
       39
       +
       

     

       40
       40
       +
       ### File Analysis

     

       41
       41
       +
       

     

       42
       42
       +
       ```bash

     

       43
       43
       +
       # Basic file information

     

       44
       44
       +
       mlgpx info file.gpx

     

       45
       45
       +
       

     

       46
       46
       +
       # Detailed analysis with waypoint details

     

       47
       47
       +
       mlgpx info --verbose file.gpx

     

       48
       48
       +
       ```

     

       49
       49
       +
       

     

       50
       50
       +
       ### Help

     

       51
       51
       +
       

     

       52
       52
       +
       ```bash

     

       53
       53
       +
       # General help

     

       54
       54
       +
       mlgpx --help

     

       55
       55
       +
       

     

       56
       56
       +
       # Command-specific help

     

       57
       57
       +
       mlgpx convert --help

     

       58
       58
       +
       mlgpx info --help

     

       59
       59
       +
       ```

     

       60
       60
       +
       

     

       6
       61
        
       ## Architecture Overview

     

       7
       62
        
       

     

       8
       63
        
       The library is split into four main components:

     

       9
       64
        
       

     

       10
       65
        
       ### Core Library (`gpx`)

     

       11
       11
       -
       - **Portable**: No Unix dependencies, works with js_of_ocaml

     

       66
       66
       +
       - **Portable**: No Unix dependencies, works with `js_of_ocaml`

     

       12
       67
        
       - **Streaming**: Uses xmlm for memory-efficient XML processing

     

       13
       68
        
       - **Type-safe**: Strong typing with validation for coordinates and GPS data

     

       14
       69
        
       - **Pure functional**: No side effects in the core parsing/writing logic

     
···

       228
       283
        
       

     

       229
       284
        
       let () = create_simple_gpx ()

     

       230
       285
        
       ```

     

       231
       231
       -
       

     

       232
       232
       -
       ## Command Line Usage

     

       233
       233
       -
       

     

       234
       234
       -
       The `mlgpx` CLI provides tools for manipulating GPX files from the command line.

     

       235
       235
       -
       

     

       236
       236
       -
       ### Installation

     

       237
       237
       -
       

     

       238
       238
       -
       ```bash

     

       239
       239
       -
       # Install from source

     

       240
       240
       -
       dune build @install

     

       241
       241
       -
       dune install

     

       242
       242
       -
       

     

       243
       243
       -
       # Or use opam (when published)

     

       244
       244
       -
       opam install mlgpx

     

       245
       245
       -
       ```

     

       246
       246
       -
       

     

       247
       247
       -
       ### Convert Waypoints to Track

     

       248
       248
       -
       

     

       249
       249
       -
       ```bash

     

       250
       250
       -
       # Basic conversion

     

       251
       251
       -
       mlgpx convert waypoints.gpx track.gpx

     

       252
       252
       -
       

     

       253
       253
       -
       # With custom track name

     

       254
       254
       -
       mlgpx convert --name "My Route" waypoints.gpx route.gpx

     

       255
       255
       -
       

     

       256
       256
       -
       # Sort waypoints by timestamp before conversion

     

       257
       257
       -
       mlgpx convert --sort-time waypoints.gpx sorted_track.gpx

     

       258
       258
       -
       

     

       259
       259
       -
       # Sort by name and preserve original waypoints

     

       260
       260
       -
       mlgpx convert --sort-name --preserve waypoints.gpx mixed.gpx

     

       261
       261
       -
       

     

       262
       262
       -
       # Verbose output with description

     

       263
       263
       -
       mlgpx convert --verbose --desc "Generated route" waypoints.gpx track.gpx

     

       264
       264
       -
       ```

     

       265
       265
       -
       

     

       266
       266
       -
       ### File Analysis

     

       267
       267
       -
       

     

       268
       268
       -
       ```bash

     

       269
       269
       -
       # Basic file information

     

       270
       270
       -
       mlgpx info file.gpx

     

       271
       271
       -
       

     

       272
       272
       -
       # Detailed analysis with waypoint details

     

       273
       273
       -
       mlgpx info --verbose file.gpx

     

       274
       274
       -
       ```

     

       275
       275
       -
       

     

       276
       276
       -
       ### Help

     

       277
       277
       -
       

     

       278
       278
       -
       ```bash

     

       279
       279
       -
       # General help

     

       280
       280
       -
       mlgpx --help

     

       281
       281
       -
       

     

       282
       282
       -
       # Command-specific help

     

       283
       283
       -
       mlgpx convert --help

     

       284
       284
       -
       mlgpx info --help

     

       285
       285
       -
       ```

+1 -1

bin/dune

···

       1
       1
        
       (executable

     

       2
       2
        
        (public_name mlgpx)

     

       3
       3
        
        (name mlgpx_cli)

     

       4
       4
       -
        (libraries gpx gpx_eio cmdliner eio_main fmt fmt.tty fmt.cli))
     

       4
       4
       +
        (libraries gpx gpx_eio cmdliner eio_main fmt fmt.tty fmt.cli))

+73 -89

bin/mlgpx_cli.ml

···

       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 = [] }]

     

       36
       36
       +
           Track.Segment.make waypoints :: []

     

       38
       37
        
       

     

       39
       38
        
       let sort_waypoints sort_by_time sort_by_name waypoints =

     

       40
       39
        
         if sort_by_time then

     

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

     

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

     

       40
       40
       +
           List.sort (fun wpt1 wpt2 ->

     

       41
       41
       +
             match Waypoint.time wpt1, Waypoint.time wpt2 with

     

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

     

       44
       43
        
             | Some _, None -> -1

     

       45
       44
        
             | None, Some _ -> 1

     

       46
       45
        
             | None, None -> 0

     

       47
       46
        
           ) waypoints

     

       48
       47
        
         else if sort_by_name then

     

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

     

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

     

       48
       48
       +
           List.sort (fun wpt1 wpt2 ->

     

       49
       49
       +
             match Waypoint.name wpt1, Waypoint.name wpt2 with

     

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

     

       52
       51
        
             | Some _, None -> -1

     

       53
       52
        
             | None, Some _ -> 1

     
···

       72
       71
        
             

     

       73
       72
        
             if verbose then

     

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

     

       75
       75
       -
                 (List.length gpx.waypoints)

     

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

     

       74
       74
       +
                 (Doc.waypoint_count gpx)

     

       75
       75
       +
                 (Doc.track_count gpx);

     

       77
       76
        
             

     

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

     

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

     

       78
       78
       +
             if Doc.waypoints gpx = [] then (

     

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

     

       81
       80
        
               exit 1

     

       82
       81
        
             );

     

       83
       82
        
             

     

       84
       83
        
             (* Sort waypoints if requested *)

     

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

     

       84
       84
       +
             let sorted_waypoints = sort_waypoints sort_by_time sort_by_name (Doc.waypoints gpx) in

     

       86
       85
        
             

     

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

     

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

     
···

       91
       90
        
             let track_segments = waypoints_to_track_segments sorted_waypoints in

     

       92
       91
        
             

     

       93
       92
        
             (* Create the new track *)

     

       94
       94
       -
             let new_track = {

     

       95
       95
       -
               name = Some track_name;

     

       93
       93
       +
             let new_track = Track.make ~name:track_name in

     

       94
       94
       +
             let new_track = { new_track with 

     

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

     

       97
       96
        
               desc = track_desc;

     

       98
       97
        
               src = Some "mlgpx";

     

       99
       99
       -
               links = [];

     

       100
       100
       -
               number = None;

     

       101
       98
        
               type_ = Some "converted";

     

       102
       102
       -
               extensions = [];

     

       103
       99
        
               trksegs = track_segments;

     

       104
       100
        
             } in

     

       105
       101
        
             

     

       106
       102
        
             if verbose then (

     

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

     

       103
       103
       +
               let total_points = List.fold_left (fun acc seg -> acc + Track.Segment.point_count seg) 0 track_segments in

     

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

     

       109
       105
        
                 (bold_style Fmt.string) track_name

     

       110
       106
        
                 (List.length track_segments) total_points

     

       111
       107
        
             );

     

       112
       108
        
             

     

       113
       109
        
             (* 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

     

       110
       110
       +
             let output_gpx = 

     

       111
       111
       +
               if preserve_waypoints then

     

       112
       112
       +
                 Doc.add_track gpx new_track

     

       113
       113
       +
               else

     

       114
       114
       +
                 Doc.add_track (Doc.clear_waypoints gpx) new_track in

     

       115
       115
       +
             let output_gpx = 

     

       116
       116
       +
               match Doc.metadata gpx with

     

       117
       117
       +
                 | Some meta -> 

     

       118
       118
       +
                     let desc = match Metadata.description meta with

     

       121
       119
        
                       | 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

     

       120
       120
       +
                       | None -> "Waypoints converted to track" in

     

       121
       121
       +
                     Doc.with_metadata output_gpx { meta with desc = Some desc }

     

       122
       122
       +
                 | None -> 

     

       123
       123
       +
                     let meta = Metadata.make ~name:"Converted" in

     

       124
       124
       +
                     let meta = { meta with desc = Some "Waypoints converted to track" } in

     

       125
       125
       +
                     Doc.with_metadata output_gpx meta in

     

       127
       126
        
             

     

       128
       127
        
             (* Validate output *)

     

       129
       129
       -
             let validation = validate_gpx output_gpx in

     

       128
       128
       +
             let validation = Gpx.validate_gpx output_gpx in

     

       130
       129
        
             if not validation.is_valid then (

     

       131
       130
        
               log_error "Generated GPX failed validation:";

     

       132
       132
       -
               List.iter (fun issue ->

     

       131
       131
       +
               List.iter (fun (issue : Gpx.validation_issue) ->

     

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

     

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

     

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

     
···

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

     

       148
       147
        
               log_info "Output contains:";

     

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

     

       150
       150
       -
                 (List.length output_gpx.waypoints)

     

       149
       149
       +
                 (Doc.waypoint_count output_gpx)

     

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

     

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

     

       153
       153
       -
                 (List.length output_gpx.tracks)

     

       152
       152
       +
                 (Doc.track_count output_gpx)

     

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

     

       155
       155
       -
                 (List.length gpx.tracks)

     

       154
       154
       +
                 (Doc.track_count gpx)

     

       156
       155
        
             ) else (

     

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

     

       158
       157
        
                 (List.length sorted_waypoints)

     
···

       162
       161
        
             

     

       163
       162
        
           with

     

       164
       163
        
           | 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);

     

       164
       164
       +
               log_error "GPX Error: %s" (Error.to_string err);

     

       174
       165
        
               exit 2

     

       175
       166
        
           | Sys_error msg ->

     

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

     
···

       186
       177
        
         let times = ref [] in

     

       187
       178
        
         

     

       188
       179
        
         (* Collect from waypoints *)

     

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

     

       190
       190
       -
           match wpt.time with

     

       180
       180
       +
         List.iter (fun wpt ->

     

       181
       181
       +
           match Waypoint.time wpt with

     

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

     

       192
       183
        
           | None -> ()

     

       193
       193
       -
         ) gpx.waypoints;

     

       184
       184
       +
         ) (Doc.waypoints gpx);

     

       194
       185
        
         

     

       195
       186
        
         (* Collect from routes *)

     

       196
       187
        
         List.iter (fun route ->

     

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

     

       198
       198
       -
             match rtept.time with

     

       188
       188
       +
           List.iter (fun rtept ->

     

       189
       189
       +
             match Waypoint.time rtept with

     

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

     

       200
       191
        
             | None -> ()

     

       201
       201
       -
           ) route.rtepts

     

       202
       202
       -
         ) gpx.routes;

     

       192
       192
       +
           ) (Route.points route)

     

       193
       193
       +
         ) (Doc.routes gpx);

     

       203
       194
        
         

     

       204
       195
        
         (* Collect from tracks *)

     

       205
       196
        
         List.iter (fun track ->

     

       206
       197
        
           List.iter (fun seg ->

     

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

     

       208
       208
       -
               match trkpt.time with

     

       198
       198
       +
             List.iter (fun trkpt ->

     

       199
       199
       +
               match Waypoint.time trkpt with

     

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

     

       210
       201
        
               | None -> ()

     

       211
       211
       -
             ) seg.trkpts

     

       212
       212
       -
           ) track.trksegs

     

       213
       213
       -
         ) gpx.tracks;

     

       202
       202
       +
             ) (Track.Segment.points seg)

     

       203
       203
       +
           ) (Track.segments track)

     

       204
       204
       +
         ) (Doc.tracks gpx);

     

       214
       205
        
         

     

       215
       206
        
         !times

     

       216
       207
        
       

     
···

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

     

       231
       222
        
             

     

       232
       223
        
             (* Basic info *)

     

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

     

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

     

       224
       224
       +
             Printf.printf "  Version: %s\n" (Doc.version gpx);

     

       225
       225
       +
             Printf.printf "  Creator: %s\n" (Doc.creator gpx);

     

       235
       226
        
             

     

       236
       236
       -
             (match gpx.metadata with

     

       227
       227
       +
             (match Doc.metadata gpx with

     

       237
       228
        
              | 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

     

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

     

       230
       230
       +
                  Printf.printf "  Description: %s\n" (Option.value (Metadata.description meta) ~default:"<none>");

     

       231
       231
       +
                  (match Metadata.time meta with

     

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

     

       242
       233
        
                   | None -> ())

     

       243
       234
        
              | None -> 

     
···

       245
       236
        
             

     

       246
       237
        
             (* Content summary *)

     

       247
       238
        
             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);

     

       239
       239
       +
             Printf.printf "  Waypoints: %d\n" (Doc.waypoint_count gpx);

     

       240
       240
       +
             Printf.printf "  Routes: %d\n" (Doc.route_count gpx);

     

       241
       241
       +
             Printf.printf "  Tracks: %d\n" (Doc.track_count gpx);

     

       251
       242
        
             

     

       252
       243
        
             (* Time range *)

     

       253
       244
        
             let all_times = collect_all_timestamps gpx in

     
···

       286
       277
        
             );

     

       287
       278
        
             

     

       288
       279
        
             (* Detailed waypoint info *)

     

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

     

       280
       280
       +
             if Doc.waypoints gpx <> [] then (

     

       290
       281
        
               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

     

       282
       282
       +
               let waypoints_with_time = List.filter (fun wpt -> Waypoint.time wpt <> None) (Doc.waypoints gpx) in

     

       283
       283
       +
               let waypoints_with_elevation = List.filter (fun wpt -> Waypoint.elevation wpt <> None) (Doc.waypoints gpx) in

     

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

     

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

     

       295
       286
        
               

     

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

     

       287
       287
       +
               if verbose && List.length (Doc.waypoints gpx) <= 10 then (

     

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

     

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

     

       289
       289
       +
                 List.iteri (fun i wpt ->

     

       290
       290
       +
                   let lat, lon = Waypoint.to_floats wpt in

     

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

     

       300
       292
        
                     (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

     

       293
       293
       +
                     (Option.value (Waypoint.name wpt) ~default:"<unnamed>")

     

       294
       294
       +
                     lat lon

     

       295
       295
       +
                     (match Waypoint.elevation wpt with Some e -> Printf.sprintf " elev=%.1fm" e | None -> "")

     

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

     

       297
       297
       +
                 ) (Doc.waypoints gpx)

     

       306
       298
        
               )

     

       307
       299
        
             );

     

       308
       300
        
             

     

       309
       301
        
             (* Track info *)

     

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

     

       302
       302
       +
             if Doc.tracks gpx <> [] then (

     

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

     

       312
       304
        
               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

     

       305
       305
       +
                 let total_points = Track.point_count track in

     

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

     

       315
       307
        
                   (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

     

       308
       308
       +
                   (Option.value (Track.name track) ~default:"<unnamed>")

     

       309
       309
       +
                   (Track.segment_count track) total_points

     

       310
       310
       +
               ) (Doc.tracks gpx)

     

       319
       311
        
             );

     

       320
       312
        
             

     

       321
       313
        
             (* Validation *)

     

       322
       322
       -
             let validation = validate_gpx gpx in

     

       314
       314
       +
             let validation = Gpx.validate_gpx gpx in

     

       323
       315
        
             Printf.printf "\n";

     

       324
       316
        
             if validation.is_valid then

     

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

     

       326
       318
        
             else (

     

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

     

       328
       328
       -
               List.iter (fun issue ->

     

       320
       320
       +
               List.iter (fun (issue : Gpx.validation_issue) ->

     

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

     

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

     

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

     
···

       334
       326
        
             

     

       335
       327
        
           with

     

       336
       328
        
           | 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);

     

       329
       329
       +
               log_error "GPX Error: %s" (Error.to_string err);

     

       346
       330
        
               exit 2

     

       347
       331
        
           | Sys_error msg ->

     

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

+14 -5

dune-project

···

       1
       1
       -
       (lang dune 3.15)

     

       1
       1
       +
       (lang dune 3.18)

     

       2
       2
       +
       

     

       3
       3
       +
       (name mlgpx)

     

       4
       4
       +
       

     

       5
       5
       +
       (generate_opam_files true)

     

       2
       6
        
       

     

       3
       7
        
       (package

     

       4
       8
        
        (name mlgpx)

     

       5
       5
       -
        (depends ocaml dune xmlm ptime eio ppx_expect alcotest eio_main cmdliner fmt logs)

     

       6
       6
       -
        (synopsis "OCaml library for parsing and generating GPX files")

     

       9
       9
       +
        (depends ocaml dune xmlm ptime (eio (>= 1.2)) ppx_expect alcotest eio_main cmdliner fmt logs)

     

       10
       10
       +
        (synopsis "Library and CLI for parsing and generating GPS Exchange (GPX) formats")

     

       7
       11
        
        (description

     

       8
       12
        
         "mlgpx is a streaming GPX (GPS Exchange Format) library for OCaml. It provides a portable core library using the xmlm streaming XML parser, with a separate Unix layer for file I/O operations. The library supports the complete GPX 1.1 specification including waypoints, routes, tracks, and metadata with strong type safety and validation.")

     

       9
       9
       -
        (license MIT)

     

       10
       10
       -
        (authors "Anil Madhavapeddy"))

     

       13
       13
       +
        (license ISC)

     

       14
       14
       +
        (authors "Anil Madhavapeddy")

     

       15
       15
       +
        (homepage "https://tangled.sh/@anil.recoil.org/ocaml-gpx")

     

       16
       16
       +
        (maintainers "Anil Madhavapeddy <anil@recoil.org>")

     

       17
       17
       +
        (bug_reports https://tangled.sh/@anil.recoil.org/ocaml-gpx/issues)

     

       18
       18
       +
        (maintenance_intent "(latest)")

     

       19
       19
       +
       )

+1 -7

examples/dune

···

       1
       1
        
       (executable

     

       2
       2
        
        (public_name simple_gpx)

     

       3
       3
        
        (name simple_gpx)

     

       4
       4
       -
        (libraries gpx_unix))

     

       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))

     

       4
       4
       +
        (libraries gpx xmlm))

-88

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
       -
       **)

     

       6
       6
       -
       

     

       7
       7
       -
       open Gpx_eio

     

       8
       8
       -
       

     

       9
       9
       -
       let main env =

     

       10
       10
       -
         try

     

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

     

       12
       12
       -
           

     

       13
       13
       -
           (* 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

     

       18
       18
       -
           

     

       19
       19
       -
           (* 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

     

       22
       22
       -
           

     

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

     

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

     

       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
       -
           

     

       31
       31
       -
           (* Create a route *)

     

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

     

       33
       33
       -
             (37.7749, -122.4194);

     

       34
       34
       -
             (37.7849, -122.4094);

     

       35
       35
       -
           ] in

     

       36
       36
       -
           

     

       37
       37
       -
           (* 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

     

       44
       44
       -
           

     

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

     

       46
       46
       -
           print_stats gpx;

     

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

     

       48
       48
       -
           

     

       49
       49
       -
           (* Write to file with validation *)

     

       50
       50
       -
           write_validated ~fs "example_output.gpx" gpx;

     

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

     

       52
       52
       -
           

     

       53
       53
       -
           (* Read it back and verify *)

     

       54
       54
       -
           let gpx2 = read_validated ~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";

     

       67
       67
       -
           

     

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

     

       69
       69
       -
           

     

       70
       70
       -
         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;

     

       83
       83
       -
             exit 1

     

       84
       84
       -
         | 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

+87 -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_validated "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_validated "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 = { wpt with name = Some "San Francisco"; desc = Some "Golden Gate Bridge area" } in

     

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

     

       22
       22
       +
           

     

       23
       23
       +
           (* Create GPX document *)

     

       24
       24
       +
           let gpx = Doc.empty ~creator:"mlgpx direct API example" in

     

       25
       25
       +
           let gpx = Doc.add_waypoint gpx wpt in

     

       26
       26
       +
           

     

       27
       27
       +
           (* Add metadata *)

     

       28
       28
       +
           let metadata = Metadata.empty in

     

       29
       29
       +
           let metadata = { metadata with name = Some "Example GPX File"; desc = Some "Demonstration of mlgpx library capabilities" } in

     

       30
       30
       +
           let gpx = { gpx with metadata = Some metadata } in

     

       31
       31
       +
           

     

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

     

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

     

       34
       34
       +
           let track = { track with cmt = Some "Sample GPS track"; desc = Some "Demonstrates track creation" } in

     

       35
       35
       +
           

     

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

     

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

     

       38
       38
       +
           let points = [

     

       39
       39
       +
             (37.7749, -122.4194);

     

       40
       40
       +
             (37.7849, -122.4094); 

     

       41
       41
       +
             (37.7949, -122.3994);

     

       42
       42
       +
           ] in

     

       43
       43
       +
           let track_segment = 

     

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

     

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

     

       46
       46
       +
               | Ok lat, Ok lon ->

     

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

     

       48
       48
       +
                   Track.Segment.add_point seg pt

     

       49
       49
       +
               | _ -> seg

     

       50
       50
       +
             ) track_segment points in

     

       51
       51
       +
           

     

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

     

       53
       53
       +
           let gpx = Doc.add_track gpx track in

     

       54
       54
       +
           

     

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

     

       56
       56
       +
           

     

       57
       57
       +
           (* Validate the document *)

     

       58
       58
       +
           let validation = validate_gpx gpx in

     

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

     

       60
       60
       +
           

     

       61
       61
       +
           (* Convert to XML string *)

     

       62
       62
       +
           let xml_result = write_string gpx in

     

       63
       63
       +
           (match xml_result with

     

       64
       64
       +
            | Ok xml_string ->

     

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

     

       66
       66
       +
              

     

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

     

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

     

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

     

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

     

       71
       71
       +
              close_out out_chan;

     

       72
       72
       +
              (match write_result with

     

       73
       73
       +
               | Ok () -> 

     

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

     

       75
       75
       +
                 

     

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

     

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

     

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

     

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

     

       80
       80
       +
                 close_in in_chan;

     

       81
       81
       +
                 (match read_result with

     

       82
       82
       +
                  | Ok gpx2 ->

     

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

     

       84
       84
       +
                    let validation2 = validate_gpx gpx2 in

     

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

     

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

     

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

     

       88
       88
       +
                      (List.length (Doc.waypoints gpx2)) (List.length (Doc.tracks gpx2))

     

       89
       89
       +
                  | Error e ->

     

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

     

       91
       91
       +
                 )

     

       92
       92
       +
               | Error e ->

     

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

     

       94
       94
       +
              )

     

       95
       95
       +
            | Error e ->

     

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

     

       97
       97
       +
           )

     

       98
       98
       +
         | Error e ->

     

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

     

       117
       100
        
         

     

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

       101
       101
       +
         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 lat t = t.lat

     

       43
       43
       +
       let 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
       +
       (** 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 *)

     

       9
       9
       +
       type t = {

     

       10
       10
       +
         lat : latitude;

     

       11
       11
       +
         lon : longitude;

     

       12
       12
       +
       }

     

       13
       13
       +
       

     

       14
       14
       +
       (** {2 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 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 lat : t -> latitude

     

       52
       52
       +
       

     

       53
       53
       +
       (** Extract longitude component *)

     

       54
       54
       +
       val 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 Printers} *)

     

       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

+186

lib/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 version t = t.version

     

       35
       35
       +
       

     

       36
       36
       +
       (** Get creator *)

     

       37
       37
       +
       let creator t = t.creator

     

       38
       38
       +
       

     

       39
       39
       +
       (** Get metadata *)

     

       40
       40
       +
       let metadata t = t.metadata

     

       41
       41
       +
       

     

       42
       42
       +
       (** Get waypoints *)

     

       43
       43
       +
       let waypoints t = t.waypoints

     

       44
       44
       +
       

     

       45
       45
       +
       (** Get routes *)

     

       46
       46
       +
       let routes t = t.routes

     

       47
       47
       +
       

     

       48
       48
       +
       (** Get tracks *)

     

       49
       49
       +
       let tracks t = t.tracks

     

       50
       50
       +
       

     

       51
       51
       +
       (** Get extensions *)

     

       52
       52
       +
       let extensions t = t.extensions

     

       53
       53
       +
       

     

       54
       54
       +
       (** {2 Document Modification} *)

     

       55
       55
       +
       

     

       56
       56
       +
       (** Update metadata *)

     

       57
       57
       +
       let with_metadata t metadata = { t with metadata = Some metadata }

     

       58
       58
       +
       

     

       59
       59
       +
       (** Add waypoint *)

     

       60
       60
       +
       let add_waypoint t waypoint = { t with waypoints = t.waypoints @ [waypoint] }

     

       61
       61
       +
       

     

       62
       62
       +
       (** Add waypoints *)

     

       63
       63
       +
       let add_waypoints t waypoints = { t with waypoints = t.waypoints @ waypoints }

     

       64
       64
       +
       

     

       65
       65
       +
       (** Add route *)

     

       66
       66
       +
       let add_route t route = { t with routes = t.routes @ [route] }

     

       67
       67
       +
       

     

       68
       68
       +
       (** Add routes *)

     

       69
       69
       +
       let add_routes t routes = { t with routes = t.routes @ routes }

     

       70
       70
       +
       

     

       71
       71
       +
       (** Add track *)

     

       72
       72
       +
       let add_track t track = { t with tracks = t.tracks @ [track] }

     

       73
       73
       +
       

     

       74
       74
       +
       (** Add tracks *)

     

       75
       75
       +
       let add_tracks t tracks = { t with tracks = t.tracks @ tracks }

     

       76
       76
       +
       

     

       77
       77
       +
       (** Add extensions *)

     

       78
       78
       +
       let add_extensions t extensions = { t with extensions = t.extensions @ extensions }

     

       79
       79
       +
       

     

       80
       80
       +
       (** Clear waypoints *)

     

       81
       81
       +
       let clear_waypoints t = { t with waypoints = [] }

     

       82
       82
       +
       

     

       83
       83
       +
       (** Clear routes *)

     

       84
       84
       +
       let clear_routes t = { t with routes = [] }

     

       85
       85
       +
       

     

       86
       86
       +
       (** Clear tracks *)

     

       87
       87
       +
       let clear_tracks t = { t with tracks = [] }

     

       88
       88
       +
       

     

       89
       89
       +
       (** {2 Document Analysis} *)

     

       90
       90
       +
       

     

       91
       91
       +
       (** Count waypoints *)

     

       92
       92
       +
       let waypoint_count t = List.length t.waypoints

     

       93
       93
       +
       

     

       94
       94
       +
       (** Count routes *)

     

       95
       95
       +
       let route_count t = List.length t.routes

     

       96
       96
       +
       

     

       97
       97
       +
       (** Count tracks *)

     

       98
       98
       +
       let track_count t = List.length t.tracks

     

       99
       99
       +
       

     

       100
       100
       +
       (** Count total points *)

     

       101
       101
       +
       let total_points t =

     

       102
       102
       +
         let waypoint_points = List.length t.waypoints in

     

       103
       103
       +
         let route_points = List.fold_left (fun acc route -> 

     

       104
       104
       +
           acc + Route.point_count route) 0 t.routes in

     

       105
       105
       +
         let track_points = List.fold_left (fun acc track -> 

     

       106
       106
       +
           acc + Track.point_count track) 0 t.tracks in

     

       107
       107
       +
         waypoint_points + route_points + track_points

     

       108
       108
       +
       

     

       109
       109
       +
       (** Check if document has elevation data *)

     

       110
       110
       +
       let has_elevation t =

     

       111
       111
       +
         List.exists (fun wpt -> Waypoint.elevation wpt <> None) t.waypoints ||

     

       112
       112
       +
         List.exists (fun route ->

     

       113
       113
       +
           List.exists (fun pt -> Waypoint.elevation pt <> None) (Route.points route)

     

       114
       114
       +
         ) t.routes ||

     

       115
       115
       +
         List.exists (fun track ->

     

       116
       116
       +
           List.exists (fun pt -> Waypoint.elevation pt <> None) (Track.all_points track)

     

       117
       117
       +
         ) t.tracks

     

       118
       118
       +
       

     

       119
       119
       +
       (** Check if document has time data *)

     

       120
       120
       +
       let has_time t =

     

       121
       121
       +
         List.exists (fun wpt -> Waypoint.time wpt <> None) t.waypoints ||

     

       122
       122
       +
         List.exists (fun route ->

     

       123
       123
       +
           List.exists (fun pt -> Waypoint.time pt <> None) (Route.points route)

     

       124
       124
       +
         ) t.routes ||

     

       125
       125
       +
         List.exists (fun track ->

     

       126
       126
       +
           List.exists (fun pt -> Waypoint.time pt <> None) (Track.all_points track)

     

       127
       127
       +
         ) t.tracks

     

       128
       128
       +
       

     

       129
       129
       +
       (** Check if document is empty *)

     

       130
       130
       +
       let is_empty t = 

     

       131
       131
       +
         waypoint_count t = 0 && route_count t = 0 && track_count t = 0

     

       132
       132
       +
       

     

       133
       133
       +
       (** Get statistics *)

     

       134
       134
       +
       type stats = {

     

       135
       135
       +
         waypoint_count : int;

     

       136
       136
       +
         route_count : int;

     

       137
       137
       +
         track_count : int;

     

       138
       138
       +
         total_points : int;

     

       139
       139
       +
         has_elevation : bool;

     

       140
       140
       +
         has_time : bool;

     

       141
       141
       +
       }

     

       142
       142
       +
       

     

       143
       143
       +
       let stats t = {

     

       144
       144
       +
         waypoint_count = waypoint_count t;

     

       145
       145
       +
         route_count = route_count t;

     

       146
       146
       +
         track_count = track_count t;

     

       147
       147
       +
         total_points = total_points t;

     

       148
       148
       +
         has_elevation = has_elevation t;

     

       149
       149
       +
         has_time = has_time t;

     

       150
       150
       +
       }

     

       151
       151
       +
       

     

       152
       152
       +
       (** Pretty print statistics *)

     

       153
       153
       +
       let pp_stats ppf t =

     

       154
       154
       +
         let s = stats t in

     

       155
       155
       +
         Format.fprintf ppf "@[<v>GPX Statistics:@,  Waypoints: %d@,  Routes: %d@,  Tracks: %d@,  Total points: %d@,  Has elevation data: %s@,  Has time data: %s@]"

     

       156
       156
       +
           s.waypoint_count s.route_count s.track_count s.total_points

     

       157
       157
       +
           (if s.has_elevation then "yes" else "no")

     

       158
       158
       +
           (if s.has_time then "yes" else "no")

     

       159
       159
       +
       

     

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

     

       161
       161
       +
       

     

       162
       162
       +
       (** Compare documents *)

     

       163
       163
       +
       let compare t1 t2 =

     

       164
       164
       +
         let version_cmp = String.compare t1.version t2.version in

     

       165
       165
       +
         if version_cmp <> 0 then version_cmp

     

       166
       166
       +
         else

     

       167
       167
       +
           let creator_cmp = String.compare t1.creator t2.creator in

     

       168
       168
       +
           if creator_cmp <> 0 then creator_cmp

     

       169
       169
       +
           else

     

       170
       170
       +
             let waypoints_cmp = List.compare Waypoint.compare t1.waypoints t2.waypoints in

     

       171
       171
       +
             if waypoints_cmp <> 0 then waypoints_cmp

     

       172
       172
       +
             else

     

       173
       173
       +
               let routes_cmp = List.compare Route.compare t1.routes t2.routes in

     

       174
       174
       +
               if routes_cmp <> 0 then routes_cmp

     

       175
       175
       +
               else List.compare Track.compare t1.tracks t2.tracks

     

       176
       176
       +
       

     

       177
       177
       +
       (** Test document equality *)

     

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

     

       179
       179
       +
       

     

       180
       180
       +
       (** Pretty print document *)

     

       181
       181
       +
       let pp ppf t =

     

       182
       182
       +
         let stats = stats t in

     

       183
       183
       +
         Format.fprintf ppf "GPX v%s by %s (%d wpt, %d routes, %d tracks, %d total points)"

     

       184
       184
       +
           t.version t.creator 

     

       185
       185
       +
           stats.waypoint_count stats.route_count stats.track_count stats.total_points

     

       186
       186
       +

+128

lib/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 version : t -> string

     

       36
       36
       +
       

     

       37
       37
       +
       (** Get creator *)

     

       38
       38
       +
       val creator : t -> string

     

       39
       39
       +
       

     

       40
       40
       +
       (** Get metadata *)

     

       41
       41
       +
       val metadata : t -> Metadata.t option

     

       42
       42
       +
       

     

       43
       43
       +
       (** Get waypoints *)

     

       44
       44
       +
       val waypoints : t -> Waypoint.t list

     

       45
       45
       +
       

     

       46
       46
       +
       (** Get routes *)

     

       47
       47
       +
       val routes : t -> Route.t list

     

       48
       48
       +
       

     

       49
       49
       +
       (** Get tracks *)

     

       50
       50
       +
       val tracks : t -> Track.t list

     

       51
       51
       +
       

     

       52
       52
       +
       (** Get extensions *)

     

       53
       53
       +
       val extensions : t -> Extension.t list

     

       54
       54
       +
       

     

       55
       55
       +
       (** {2 Document Modification} *)

     

       56
       56
       +
       

     

       57
       57
       +
       (** Update metadata *)

     

       58
       58
       +
       val with_metadata : t -> Metadata.t -> t

     

       59
       59
       +
       

     

       60
       60
       +
       (** Add waypoint *)

     

       61
       61
       +
       val add_waypoint : t -> Waypoint.t -> t

     

       62
       62
       +
       

     

       63
       63
       +
       (** Add waypoints *)

     

       64
       64
       +
       val add_waypoints : t -> Waypoint.t list -> t

     

       65
       65
       +
       

     

       66
       66
       +
       (** Add route *)

     

       67
       67
       +
       val add_route : t -> Route.t -> t

     

       68
       68
       +
       

     

       69
       69
       +
       (** Add routes *)

     

       70
       70
       +
       val add_routes : t -> Route.t list -> t

     

       71
       71
       +
       

     

       72
       72
       +
       (** Add track *)

     

       73
       73
       +
       val add_track : t -> Track.t -> t

     

       74
       74
       +
       

     

       75
       75
       +
       (** Add tracks *)

     

       76
       76
       +
       val add_tracks : t -> Track.t list -> t

     

       77
       77
       +
       

     

       78
       78
       +
       (** Add extensions *)

     

       79
       79
       +
       val add_extensions : t -> Extension.t list -> t

     

       80
       80
       +
       

     

       81
       81
       +
       (** Clear waypoints *)

     

       82
       82
       +
       val clear_waypoints : t -> t

     

       83
       83
       +
       

     

       84
       84
       +
       (** Clear routes *)

     

       85
       85
       +
       val clear_routes : t -> t

     

       86
       86
       +
       

     

       87
       87
       +
       (** Clear tracks *)

     

       88
       88
       +
       val clear_tracks : t -> t

     

       89
       89
       +
       

     

       90
       90
       +
       (** {2 Document Analysis} *)

     

       91
       91
       +
       

     

       92
       92
       +
       (** Count waypoints *)

     

       93
       93
       +
       val waypoint_count : t -> int

     

       94
       94
       +
       

     

       95
       95
       +
       (** Count routes *)

     

       96
       96
       +
       val route_count : t -> int

     

       97
       97
       +
       

     

       98
       98
       +
       (** Count tracks *)

     

       99
       99
       +
       val track_count : t -> int

     

       100
       100
       +
       

     

       101
       101
       +
       (** Count total points *)

     

       102
       102
       +
       val total_points : t -> int

     

       103
       103
       +
       

     

       104
       104
       +
       (** Check if document has elevation data *)

     

       105
       105
       +
       val has_elevation : t -> bool

     

       106
       106
       +
       

     

       107
       107
       +
       (** Check if document has time data *)

     

       108
       108
       +
       val has_time : t -> bool

     

       109
       109
       +
       

     

       110
       110
       +
       (** Check if document is empty *)

     

       111
       111
       +
       val is_empty : t -> bool

     

       112
       112
       +
       

     

       113
       113
       +
       (** Get document statistics *)

     

       114
       114
       +
       val stats : t -> stats

     

       115
       115
       +
       

     

       116
       116
       +
       (** Pretty print statistics *)

     

       117
       117
       +
       val pp_stats : Format.formatter -> t -> unit

     

       118
       118
       +
       

     

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

     

       120
       120
       +
       

     

       121
       121
       +
       (** Compare documents *)

     

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

     

       123
       123
       +
       

     

       124
       124
       +
       (** Test document equality *)

     

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

     

       126
       126
       +
       

     

       127
       127
       +
       (** Pretty print document *)

     

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

+14 -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

     

       6
       6
       +
         gpx

     

       7
       7
       +
         parser

     

       8
       8
       +
         writer

     

       9
       9
       +
         validate

     

       10
       10
       +
         coordinate

     

       11
       11
       +
         link

     

       12
       12
       +
         extension

     

       13
       13
       +
         waypoint

     

       14
       14
       +
         metadata

     

       15
       15
       +
         route

     

       16
       16
       +
         track

     

       17
       17
       +
         error

     

       18
       18
       +
         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 name t = t.name

     

       37
       37
       +
       

     

       38
       38
       +
       (** Get optional namespace *)

     

       39
       39
       +
       let namespace t = t.namespace

     

       40
       40
       +
       

     

       41
       41
       +
       (** Get attributes *)

     

       42
       42
       +
       let attributes t = t.attributes

     

       43
       43
       +
       

     

       44
       44
       +
       (** Get content *)

     

       45
       45
       +
       let 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 text_content_extract = function Text s -> Some s | _ -> None

     

       139
       139
       +
       

     

       140
       140
       +
       (** Extract element content *)

     

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

     

       142
       142
       +
       

     

       143
       143
       +
       (** Extract mixed content *)

     

       144
       144
       +
       let mixed_content_extract = 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 -> 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 name : t -> string

     

       35
       35
       +
       

     

       36
       36
       +
       (** Get optional namespace *)

     

       37
       37
       +
       val namespace : t -> string option

     

       38
       38
       +
       

     

       39
       39
       +
       (** Get attributes *)

     

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

     

       41
       41
       +
       

     

       42
       42
       +
       (** Get content *)

     

       43
       43
       +
       val 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 text_content_extract : content -> string option

     

       82
       82
       +
       

     

       83
       83
       +
       (** Extract element content *)

     

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

     

       85
       85
       +
       

     

       86
       86
       +
       (** Extract mixed content *)

     

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

+86 -56

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

     

       40
       16
        
       

     

       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

     

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

     

       18
       18
       +
       module Metadata = Metadata

     

       53
       19
        
       

     

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

     

       55
       55
       -
       let parse = Parser.parse

     

       56
       56
       -
       let parse_string = Parser.parse_string

     

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

     

       21
       21
       +
       module Route = Route

     

       57
       22
        
       

     

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

     

       59
       59
       -
       let write = Writer.write

     

       60
       60
       -
       let write_string = Writer.write_string

     

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

     

       24
       24
       +
       module Track = Track

     

       61
       25
        
       

     

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

     

       26
       26
       +
       (** Error handling *)

     

       27
       27
       +
       module Error = Error

     

       28
       28
       +
       

     

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

     

       30
       30
       +
       module Doc = Doc

     

       31
       31
       +
       

     

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

     

       33
       33
       +
       

     

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

     

       35
       35
       +
       type t = Doc.t

     

       36
       36
       +
       

     

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

     

       38
       38
       +
       

     

       39
       39
       +
       (** Error types *)

     

       40
       40
       +
       type error = Error.t

     

       41
       41
       +
       

     

       42
       42
       +
       (** GPX exception *)

     

       43
       43
       +
       exception Gpx_error of error

     

       44
       44
       +
       

     

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

     

       46
       46
       +
       

     

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

     

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

     

       49
       49
       +
       

     

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

     

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

     

       52
       52
       +
       

     

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

     

       54
       54
       +
       

     

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

     

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

     

       57
       57
       +
       

     

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

     

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

     

       60
       60
       +
       

     

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

     

       62
       62
       +
       

     

       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
       +
       }

     

       69
       69
       +
       

     

       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;

     

       74
       74
       +
       }

     

       75
       75
       +
       

     

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

     

       63
       77
        
       let validate_gpx = Validate.validate_gpx

     

       78
       78
       +
       

     

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

     

       64
       80
        
       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
     

       81
       81
       +
       

     

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

     

       83
       83
       +
       let errors = Validate.errors

     

       84
       84
       +
       

     

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

     

       86
       86
       +
       let warnings = Validate.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 = Doc.empty ~creator

     

       95
       95
       +
       

     

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

     

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

+462 -317

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
       -
       

     

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

     

       2
       2
       +
           

     

       3
       3
       +
           {1 Overview}

     

       4
       4
       +
           

     

       5
       5
       +
           GPX (GPS Exchange Format) is an XML-based format for GPS data interchange,

     

       6
       6
       +
           standardized by {{:https://www.topografix.com/gpx.asp}Topografix}. This library

     

       7
       7
       +
           provides a complete implementation of the GPX 1.1 specification with strong

     

       8
       8
       +
           type safety and validation.

     

       9
       9
       +
           

     

       10
       10
       +
           GPX files can contain three main types of GPS data:

     

       11
       11
       +
           - {b Waypoints}: Individual points of interest with coordinates

     

       12
       12
       +
           - {b Routes}: Ordered sequences of waypoints representing a planned path

     

       13
       13
       +
           - {b Tracks}: Recorded GPS traces, typically from actual journeys

     

       14
       14
       +
           

     

       15
       15
       +
           All coordinates in GPX use the WGS84 datum (World Geodetic System 1984),

     

       16
       16
       +
           the same coordinate system used by GPS satellites. Coordinates are expressed

     

       17
       17
       +
           as decimal degrees, with elevations in meters above mean sea level.

     

       18
       18
       +
           

     

       19
       19
       +
           {2 Quick Start Example}

     

       20
       20
       +
           

     

       22
       21
        
           {[

     

       23
       22
        
             open Gpx

     

       24
       24
       -
       

     

       23
       23
       +
             

     

       25
       24
        
             (* Create coordinates *)

     

       26
       26
       -
             let* lat = latitude 37.7749 in

     

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

     

       25
       25
       +
             let lat = Coordinate.latitude 37.7749 |> Result.get_ok in

     

       26
       26
       +
             let lon = Coordinate.longitude (-122.4194) |> Result.get_ok in

     

       28
       27
        
             

     

       29
       28
        
             (* Create a waypoint *)

     

       30
       30
       -
             let wpt = make_waypoint_data lat lon in

     

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

     

       29
       29
       +
             let waypoint = Waypoint.make lat lon 

     

       30
       30
       +
               |> Waypoint.with_name "San Francisco"

     

       31
       31
       +
               |> Waypoint.with_description "Golden Gate Bridge area" 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

     

       34
       34
       +
             let gpx = make_gpx ~creator:"my-app" 

     

       35
       35
       +
               |> Doc.add_waypoint waypoint in

     

       36
       36
        
             

     

       37
       37
       -
             (* Convert to XML string *)

     

       38
       38
       -
             write_string gpx

     

       37
       37
       +
             (* Write to file or string *)

     

       38
       38
       +
             match write_string gpx with

     

       39
       39
       +
             | Ok xml -> print_endline xml

     

       40
       40
       +
             | Error e -> Printf.eprintf "Error: %s\n" (Error.to_string e)

     

       39
       41
        
           ]}

     

       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
       -
       }

     

       123
       123
       -
       

     

       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
       -
       }

     

       131
       131
       -
       

     

       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 *)

     

       137
       137
       -
       

     

       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
       -
       }

     

       145
       145
       -
       

     

       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
       -
       }

     

       158
       158
       -
       

     

       159
       159
       -
       (** Create empty metadata record *)

     

       160
       160
       -
       val empty_metadata : metadata

     

       161
       161
       -
       

     

       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
       -
       }

     

       42
       42
       +
           

     

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

     

       44
       44
       +
           with separate modules for each major component of the GPX specification. *)

     

       191
       45
        
       

     

       192
       192
       -
       (** Create basic waypoint data with required coordinates *)

     

       193
       193
       -
       val make_waypoint_data : latitude -> longitude -> waypoint_data

     

       46
       46
       +
       (** {1 Core Modules}

     

       47
       47
       +
           

     

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

     

       49
       49
       +
           of GPX data. Each module provides complete functionality for its domain with

     

       50
       50
       +
           strong type safety and validation. *)

     

       194
       51
        
       

     

       195
       195
       -
       (** Individual waypoint - a point of interest *)

     

       196
       196
       -
       type waypoint = Types.waypoint

     

       52
       52
       +
       (** {2 Geographic coordinate handling with validation}

     

       53
       53
       +
           

     

       54
       54
       +
           The {!Coordinate} module provides validated coordinate types for latitude,

     

       55
       55
       +
           longitude, and degrees. All coordinates use the WGS84 datum and are validated

     

       56
       56
       +
           at construction time to ensure they fall within valid ranges:

     

       57
       57
       +
           - Latitude: -90.0 to +90.0 degrees

     

       58
       58
       +
           - Longitude: -180.0 to +180.0 degrees  

     

       59
       59
       +
           - Degrees: 0.0 to 360.0 degrees

     

       60
       60
       +
           

     

       61
       61
       +
           Example: [Coordinate.latitude 37.7749] creates a validated latitude. *)

     

       62
       62
       +
       module Coordinate = Coordinate

     

       197
       63
        
       

     

       198
       198
       -
       (** Route point - point along a planned route *)

     

       199
       199
       -
       type route_point = Types.route_point  

     

       64
       64
       +
       (** {2 Links, persons, and copyright information}

     

       65
       65
       +
           

     

       66
       66
       +
           The {!Link} module handles web links, author information, and copyright data

     

       67
       67
       +
           as defined in the GPX specification. This includes:

     

       68
       68
       +
           - Web links with optional text and MIME type

     

       69
       69
       +
           - Person records with name, email, and associated links

     

       70
       70
       +
           - Copyright information with author, year, and license terms *)

     

       71
       71
       +
       module Link = Link

     

       200
       72
        
       

     

       201
       201
       -
       (** Track point - recorded position along an actual path *)

     

       202
       202
       -
       type track_point = Types.track_point

     

       73
       73
       +
       (** {2 Extension mechanism for custom GPX elements}

     

       74
       74
       +
           

     

       75
       75
       +
           The {!Extension} module provides support for custom XML elements that extend

     

       76
       76
       +
           the standard GPX format. Extensions allow applications to embed additional

     

       77
       77
       +
           data while maintaining compatibility with standard GPX readers. *)

     

       78
       78
       +
       module Extension = Extension

     

       203
       79
        
       

     

       204
       204
       -
       (** {3 Routes}

     

       80
       80
       +
       (** {2 GPS waypoint data and fix types}

     

       81
       81
       +
           

     

       82
       82
       +
           The {!Waypoint} module handles individual GPS points, including waypoints,

     

       83
       83
       +
           route points, and track points. Each waypoint contains:

     

       84
       84
       +
           - Required coordinates (latitude/longitude)

     

       85
       85
       +
           - Optional elevation in meters above mean sea level

     

       86
       86
       +
           - Optional timestamp

     

       87
       87
       +
           - Optional metadata like name, description, symbol

     

       88
       88
       +
           - Optional GPS quality information (accuracy, satellite count, etc.)

     

       89
       89
       +
           

     

       90
       90
       +
           Fix types indicate GPS quality: none, 2D, 3D, DGPS, or PPS. *)

     

       91
       91
       +
       module Waypoint = Waypoint

     

       205
       92
        
       

     

       206
       206
       -
           A route is an ordered list of waypoints representing a planned path. *)

     

       93
       93
       +
       (** {2 GPX metadata including bounds}

     

       94
       94
       +
           

     

       95
       95
       +
           The {!Metadata} module handles document-level information:

     

       96
       96
       +
           - File name and description

     

       97
       97
       +
           - Author and copyright information

     

       98
       98
       +
           - Creation time and keywords

     

       99
       99
       +
           - Geographic bounding box of all data

     

       100
       100
       +
           - Links to related resources *)

     

       101
       101
       +
       module Metadata = Metadata

     

       207
       102
        
       

     

       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
       -
       }

     

       103
       103
       +
       (** {2 Route data and calculations}

     

       104
       104
       +
           

     

       105
       105
       +
           The {!Route} module handles planned paths represented as ordered sequences

     

       106
       106
       +
           of waypoints. Routes typically represent intended journeys rather than

     

       107
       107
       +
           recorded tracks. Each route can include:

     

       108
       108
       +
           - Ordered list of waypoints (route points)

     

       109
       109
       +
           - Route metadata (name, description, links)

     

       110
       110
       +
           - Distance calculations between points *)

     

       111
       111
       +
       module Route = Route

     

       220
       112
        
       

     

       221
       221
       -
       (** {3 Tracks}

     

       113
       113
       +
       (** {2 Track data with segments}

     

       114
       114
       +
           

     

       115
       115
       +
           The {!Track} module handles recorded GPS traces, typically representing

     

       116
       116
       +
           actual journeys. Tracks are divided into segments to handle GPS interruptions:

     

       117
       117
       +
           - Track segments contain ordered track points

     

       118
       118
       +
           - Each track point is a timestamped waypoint

     

       119
       119
       +
           - Multiple segments per track handle GPS signal loss

     

       120
       120
       +
           - Distance and time calculations available *)

     

       121
       121
       +
       module Track = Track

     

       222
       122
        
       

     

       223
       223
       -
           A track represents an actual recorded path, consisting of track segments. *)

     

       123
       123
       +
       (** {2 Error handling}

     

       124
       124
       +
           

     

       125
       125
       +
           The {!Error} module provides comprehensive error handling for GPX operations:

     

       126
       126
       +
           - XML parsing and validation errors

     

       127
       127
       +
           - Coordinate validation errors  

     

       128
       128
       +
           - Missing required elements or attributes

     

       129
       129
       +
           - File I/O errors *)

     

       130
       130
       +
       module Error = Error

     

       224
       131
        
       

     

       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
       -
       }

     

       132
       132
       +
       (** {2 Main GPX document type}

     

       133
       133
       +
           

     

       134
       134
       +
           The {!Doc} module represents complete GPX documents containing:

     

       135
       135
       +
           - Document metadata (creator, version)

     

       136
       136
       +
           - Collections of waypoints, routes, and tracks

     

       137
       137
       +
           - Document-level extensions

     

       138
       138
       +
           - Statistics and analysis functions *)

     

       139
       139
       +
       module Doc = Doc

     

       230
       140
        
       

     

       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
       -
       }

     

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

     

       243
       142
        
       

     

       244
       244
       -
       (** {3 Main GPX Document}

     

       245
       245
       -
       

     

       246
       246
       -
           The root GPX element contains metadata and collections of waypoints, routes, and tracks. *)

     

       247
       247
       -
       

     

       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
       -
       }

     

       258
       258
       -
       

     

       259
       259
       -
       (** Create GPX document with required creator field *)

     

       260
       260
       -
       val make_gpx : creator:string -> gpx

     

       143
       143
       +
       (** A complete GPX document containing waypoints, routes, tracks, and metadata.

     

       144
       144
       +
           

     

       145
       145
       +
           This is the main type representing a complete GPX file. GPX documents must

     

       146
       146
       +
           have a creator string (identifying the creating application) and follow the

     

       147
       147
       +
           GPX 1.1 specification format. *)

     

       148
       148
       +
       type t = Doc.t

     

       261
       149
        
       

     

       262
       262
       -
       (** {3 Error Handling} *)

     

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

     

       263
       151
        
       

     

       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 *)

     

       152
       152
       +
       (** Comprehensive error type covering all possible GPX operation failures.

     

       153
       153
       +
           

     

       154
       154
       +
           Errors can occur during:

     

       155
       155
       +
           - XML parsing (malformed XML, invalid structure)

     

       156
       156
       +
           - Coordinate validation (out of range values)

     

       157
       157
       +
           - Missing required GPX elements or attributes

     

       158
       158
       +
           - File I/O operations *)

     

       159
       159
       +
       type error = Error.t

     

       273
       160
        
       

     

       274
       274
       -
       (** Exception type for GPX errors *)

     

       161
       161
       +
       (** GPX exception raised for unrecoverable errors.

     

       162
       162
       +
           

     

       163
       163
       +
           Most functions return [Result.t] for error handling, but this exception

     

       164
       164
       +
           may be raised in exceptional circumstances. *)

     

       275
       165
        
       exception Gpx_error of error

     

       276
       166
        
       

     

       277
       277
       -
       (** Result type for operations that may fail *)

     

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

     

       167
       167
       +
       (** {1 Parsing Functions}

     

       168
       168
       +
           

     

       169
       169
       +
           Parse GPX data from various sources. All parsing functions support optional

     

       170
       170
       +
           validation to check compliance with GPX specification constraints. *)

     

       279
       171
        
       

     

       280
       280
       -
       (** {2 Parsing Functions}

     

       172
       172
       +
       (** Parse GPX from XML input source.

     

       173
       173
       +
           

     

       174
       174
       +
           Reads GPX data from an {!Xmlm.input} source, which can be created from

     

       175
       175
       +
           files, strings, or other input sources using the {{:https://erratique.ch/software/xmlm}Xmlm} library.

     

       176
       176
       +
           

     

       177
       177
       +
           @param validate If [true] (default [false]), validates the parsed document

     

       178
       178
       +
                          against GPX specification rules. Validation checks coordinate

     

       179
       179
       +
                          ranges, required elements, and data consistency.

     

       180
       180
       +
           @param input XMLm input source created with [Xmlm.make_input]

     

       181
       181
       +
           @return [Ok gpx] with parsed document, or [Error e] if parsing fails

     

       182
       182
       +
           

     

       183
       183
       +
           Example:

     

       184
       184
       +
           {[

     

       185
       185
       +
             let input = Xmlm.make_input (`String (0, gpx_xml_string)) in

     

       186
       186
       +
             match parse ~validate:true input with

     

       187
       187
       +
             | Ok gpx -> Printf.printf "Parsed %d waypoints\n" (List.length (Doc.waypoints gpx))

     

       188
       188
       +
             | Error e -> Printf.eprintf "Parse error: %s\n" (Error.to_string e)

     

       189
       189
       +
           ]} *)

     

       190
       190
       +
       val parse : ?validate:bool -> Xmlm.input -> (t, error) result

     

       281
       191
        
       

     

       282
       282
       -
           Parse GPX documents from XML input sources. *)

     

       192
       192
       +
       (** Parse GPX from XML string.

     

       193
       193
       +
           

     

       194
       194
       +
           Convenience function for parsing GPX data from a string. Equivalent to

     

       195
       195
       +
           creating an {!Xmlm.input} from the string and calling {!parse}.

     

       196
       196
       +
           

     

       197
       197
       +
           @param validate If [true] (default [false]), validates the parsed document

     

       198
       198
       +
           @param s Complete GPX XML document as a string

     

       199
       199
       +
           @return [Ok gpx] with parsed document, or [Error e] if parsing fails

     

       200
       200
       +
           

     

       201
       201
       +
           Example:

     

       202
       202
       +
           {[

     

       203
       203
       +
             let gpx_xml = {|<?xml version="1.0"?>

     

       204
       204
       +
             <gpx version="1.1" creator="my-app">

     

       205
       205
       +
               <wpt lat="37.7749" lon="-122.4194">

     

       206
       206
       +
                 <name>San Francisco</name>

     

       207
       207
       +
               </wpt>

     

       208
       208
       +
             </gpx>|} in

     

       209
       209
       +
             match parse_string ~validate:true gpx_xml with

     

       210
       210
       +
             | Ok gpx -> print_endline "Successfully parsed GPX"

     

       211
       211
       +
             | Error e -> Printf.eprintf "Error: %s\n" (Error.to_string e)

     

       212
       212
       +
           ]} *)

     

       213
       213
       +
       val parse_string : ?validate:bool -> string -> (t, error) result

     

       283
       214
        
       

     

       284
       284
       -
       (** Parse GPX document from xmlm input source.

     

       285
       285
       -
           @param input The xmlm input source

     

       286
       286
       -
           @return [Ok gpx] on success, [Error err] on failure *)

     

       287
       287
       -
       val parse : Xmlm.input -> gpx result

     

       215
       215
       +
       (** {1 Writing Functions}

     

       216
       216
       +
           

     

       217
       217
       +
           Generate GPX XML from document structures. All writing functions support

     

       218
       218
       +
           optional validation before output generation. *)

     

       288
       219
        
       

     

       289
       289
       -
       (** Parse GPX document from string.

     

       290
       290
       -
           @param xml_string GPX document as XML string  

     

       291
       291
       -
           @return [Ok gpx] on success, [Error err] on failure *)

     

       292
       292
       -
       val parse_string : string -> gpx result

     

       220
       220
       +
       (** Write GPX to XML output destination.

     

       221
       221
       +
           

     

       222
       222
       +
           Generates standard GPX 1.1 XML and writes it to an {!Xmlm.dest} destination.

     

       223
       223
       +
           The output destination can target files, buffers, or other sinks.

     

       224
       224
       +
           

     

       225
       225
       +
           @param validate If [true] (default [false]), validates the document before

     

       226
       226
       +
                          writing to ensure GPX specification compliance

     

       227
       227
       +
           @param dest XMLm output destination created with [Xmlm.make_output]  

     

       228
       228
       +
           @param gpx GPX document to write

     

       229
       229
       +
           @return [Ok ()] on success, or [Error e] if writing fails

     

       230
       230
       +
           

     

       231
       231
       +
           Example:

     

       232
       232
       +
           {[

     

       233
       233
       +
             let output = Buffer.create 1024 in

     

       234
       234
       +
             let dest = Xmlm.make_output (`Buffer output) in

     

       235
       235
       +
             match write ~validate:true dest gpx with

     

       236
       236
       +
             | Ok () -> Buffer.contents output

     

       237
       237
       +
             | Error e -> failwith (Error.to_string e)

     

       238
       238
       +
           ]} *)

     

       239
       239
       +
       val write : ?validate:bool -> Xmlm.dest -> t -> (unit, error) result

     

       293
       240
        
       

     

       294
       294
       -
       (** {2 Writing Functions}

     

       241
       241
       +
       (** Write GPX to XML string.

     

       242
       242
       +
           

     

       243
       243
       +
           Convenience function that generates a complete GPX XML document as a string.

     

       244
       244
       +
           The output includes XML declaration and proper namespace declarations.

     

       245
       245
       +
           

     

       246
       246
       +
           @param validate If [true] (default [false]), validates before writing

     

       247
       247
       +
           @param gpx GPX document to serialize

     

       248
       248
       +
           @return [Ok xml_string] with complete GPX XML, or [Error e] if generation fails

     

       249
       249
       +
           

     

       250
       250
       +
           Example:

     

       251
       251
       +
           {[

     

       252
       252
       +
             match write_string ~validate:true gpx with

     

       253
       253
       +
             | Ok xml -> 

     

       254
       254
       +
                 print_endline "Generated GPX:";

     

       255
       255
       +
                 print_endline xml

     

       256
       256
       +
             | Error e -> 

     

       257
       257
       +
                 Printf.eprintf "Failed to generate GPX: %s\n" (Error.to_string e)

     

       258
       258
       +
           ]} *)

     

       259
       259
       +
       val write_string : ?validate:bool -> t -> (string, error) result

     

       295
       260
        
       

     

       296
       296
       -
           Generate GPX XML from document structures. *)

     

       261
       261
       +
       (** {1 Validation Functions}

     

       262
       262
       +
           

     

       263
       263
       +
           Comprehensive validation against GPX specification rules and best practices.

     

       264
       264
       +
           Validation checks coordinate ranges, required elements, data consistency,

     

       265
       265
       +
           and common issues that may cause problems for GPS applications. *)

     

       297
       266
        
       

     

       298
       298
       -
       (** Write GPX document to xmlm output destination.

     

       299
       299
       -
           @param output The xmlm output destination

     

       300
       300
       -
           @param gpx The GPX document to write

     

       301
       301
       -
           @return [Ok ()] on success, [Error err] on failure *)

     

       302
       302
       -
       val write : Xmlm.output -> gpx -> unit result

     

       303
       303
       -
       

     

       304
       304
       -
       (** Write GPX document to XML string.

     

       305
       305
       -
           @param gpx The GPX document to write

     

       306
       306
       -
           @return [Ok xml_string] on success, [Error err] on failure *)

     

       307
       307
       -
       val write_string : gpx -> string result

     

       308
       308
       -
       

     

       309
       309
       -
       (** {2 Validation Functions}

     

       310
       310
       -
       

     

       311
       311
       -
           Validate GPX documents for correctness and best practices. *)

     

       312
       312
       -
       

     

       313
       313
       -
       (** Validation issue with severity level *)

     

       267
       267
       +
       (** A validation issue found during GPX document checking.

     

       268
       268
       +
           

     

       269
       269
       +
           Issues are classified as either errors (specification violations that make

     

       270
       270
       +
           the GPX invalid) or warnings (best practice violations or suspicious data). *)

     

       314
       271
        
       type validation_issue = Validate.validation_issue = {

     

       315
       315
       -
         level : [`Error | `Warning];     (** Severity level *)

     

       316
       316
       -
         message : string;                (** Issue description *)

     

       317
       317
       -
         location : string option;        (** Location in document *)

     

       272
       272
       +
         level : [`Error | `Warning];     (** [`Error] for specification violations, [`Warning] for best practice issues *)

     

       273
       273
       +
         message : string;                (** Human-readable description of the issue *)

     

       274
       274
       +
         location : string option;        (** Optional location context (e.g., "waypoint 1", "track segment 2") *)

     

       318
       275
        
       }

     

       319
       276
        
       

     

       320
       320
       -
       (** Result of validation containing all issues found *)

     

       277
       277
       +
       (** Complete validation result with all issues and validity status.

     

       278
       278
       +
           

     

       279
       279
       +
           The [is_valid] field indicates whether the document contains any errors.

     

       280
       280
       +
           Documents with only warnings are considered valid. *)

     

       321
       281
        
       type validation_result = Validate.validation_result = {

     

       322
       322
       -
         issues : validation_issue list;  (** All validation issues *)

     

       323
       323
       -
         is_valid : bool;                 (** True if no errors found *)

     

       282
       282
       +
         issues : validation_issue list;  (** All validation issues found, both errors and warnings *)

     

       283
       283
       +
         is_valid : bool;                 (** [true] if no errors found (warnings are allowed) *)

     

       324
       284
        
       }

     

       325
       285
        
       

     

       326
       326
       -
       (** Validate complete GPX document.

     

       327
       327
       -
           Checks coordinates, required fields, and best practices.

     

       328
       328
       -
           @param gpx GPX document to validate

     

       329
       329
       -
           @return Validation result with any issues found *)

     

       330
       330
       -
       val validate_gpx : gpx -> validation_result

     

       286
       286
       +
       (** Perform comprehensive validation of a GPX document.

     

       287
       287
       +
           

     

       288
       288
       +
           Checks all aspects of the GPX document against the specification:

     

       289
       289
       +
           - Coordinate ranges (latitude -90 to +90, longitude -180 to +180)

     

       290
       290
       +
           - Required elements and attributes

     

       291
       291
       +
           - Data consistency (e.g., time ordering in tracks)

     

       292
       292
       +
           - Reasonable value ranges for GPS quality metrics

     

       293
       293
       +
           - Proper structure and nesting

     

       294
       294
       +
           

     

       295
       295
       +
           @param gpx The GPX document to validate

     

       296
       296
       +
           @return Complete validation result with all issues found

     

       297
       297
       +
           

     

       298
       298
       +
           Example:

     

       299
       299
       +
           {[

     

       300
       300
       +
             let result = validate_gpx gpx in

     

       301
       301
       +
             if result.is_valid then

     

       302
       302
       +
               Printf.printf "Document is valid with %d warnings\n" 

     

       303
       303
       +
                 (List.length (List.filter (fun i -> i.level = `Warning) result.issues))

     

       304
       304
       +
             else begin

     

       305
       305
       +
               print_endline "Document has errors:";

     

       306
       306
       +
               List.iter (fun issue ->

     

       307
       307
       +
                 if issue.level = `Error then

     

       308
       308
       +
                   Printf.printf "  ERROR: %s\n" (format_issue issue)

     

       309
       309
       +
               ) result.issues

     

       310
       310
       +
             end

     

       311
       311
       +
           ]} *)

     

       312
       312
       +
       val validate_gpx : t -> validation_result

     

       331
       313
        
       

     

       332
       332
       -
       (** Quick validation check.

     

       333
       333
       -
           @param gpx GPX document to validate

     

       334
       334
       -
           @return [true] if document is valid (no errors) *)

     

       335
       335
       -
       val is_valid : gpx -> bool

     

       314
       314
       +
       (** Quick validation check - returns true if document has no errors.

     

       315
       315
       +
           

     

       316
       316
       +
           Equivalent to [(validate_gpx gpx).is_valid] but potentially more efficient

     

       317
       317
       +
           as it can stop at the first error found.

     

       318
       318
       +
           

     

       319
       319
       +
           @param gpx The GPX document to validate

     

       320
       320
       +
           @return [true] if valid (no errors), [false] if errors found *)

     

       321
       321
       +
       val is_valid : t -> bool

     

       336
       322
        
       

     

       337
       337
       -
       (** Get only error-level validation issues.

     

       338
       338
       -
           @param gpx GPX document to validate

     

       339
       339
       -
           @return List of validation errors *)

     

       340
       340
       -
       val get_errors : gpx -> validation_issue list

     

       323
       323
       +
       (** Get only validation errors (specification violations).

     

       324
       324
       +
           

     

       325
       325
       +
           Returns only the issues marked as errors, filtering out warnings.

     

       326
       326
       +
           If this list is empty, the document is valid according to the GPX specification.

     

       327
       327
       +
           

     

       328
       328
       +
           @param gpx The GPX document to validate

     

       329
       329
       +
           @return List of error-level validation issues *)

     

       330
       330
       +
       val errors : t -> validation_issue list

     

       341
       331
        
       

     

       342
       342
       -
       (** Get only warning-level validation issues.

     

       343
       343
       -
           @param gpx GPX document to validate  

     

       344
       344
       -
           @return List of validation warnings *)

     

       345
       345
       -
       val get_warnings : gpx -> validation_issue list

     

       332
       332
       +
       (** Get only validation warnings (best practice violations).

     

       333
       333
       +
           

     

       334
       334
       +
           Returns only the issues marked as warnings. These don't make the document

     

       335
       335
       +
           invalid but may indicate potential problems or areas for improvement.

     

       336
       336
       +
           

     

       337
       337
       +
           @param gpx The GPX document to validate  

     

       338
       338
       +
           @return List of warning-level validation issues *)

     

       339
       339
       +
       val warnings : t -> validation_issue list

     

       346
       340
        
       

     

       347
       347
       -
       (** Format validation issue for display.

     

       348
       348
       -
           @param issue Validation issue to format

     

       349
       349
       -
           @return Human-readable error message *)

     

       341
       341
       +
       (** Format a validation issue for human-readable display.

     

       342
       342
       +
           

     

       343
       343
       +
           Combines the issue message with location context if available.

     

       344
       344
       +
           

     

       345
       345
       +
           @param issue The validation issue to format

     

       346
       346
       +
           @return Formatted string suitable for display to users

     

       347
       347
       +
           

     

       348
       348
       +
           Example output: ["Error in waypoint 1: Latitude out of range (-95.0)"] *)

     

       350
       349
        
       val format_issue : validation_issue -> string

     

       351
       350
        
       

     

       352
       352
       -
       (** {2 Module Access}

     

       351
       351
       +
       (** {1 Document Constructors and Utilities}

     

       352
       352
       +
           

     

       353
       353
       +
           Functions for creating GPX documents and basic document operations. *)

     

       353
       354
        
       

     

       354
       354
       -
           Direct access to submodules for advanced usage. *)

     

       355
       355
       -
       

     

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

     

       357
       357
       -
       module Types = Types

     

       355
       355
       +
       (** Create a new GPX document with the required creator field.

     

       356
       356
       +
           

     

       357
       357
       +
           Every GPX document must identify its creating application through the

     

       358
       358
       +
           [creator] attribute. This is required by the GPX specification and helps

     

       359
       359
       +
           identify the source of GPS data.

     

       360
       360
       +
           

     

       361
       361
       +
           The created document:

     

       362
       362
       +
           - Uses GPX version 1.1 (the current standard)

     

       363
       363
       +
           - Contains no waypoints, routes, or tracks initially

     

       364
       364
       +
           - Has no metadata initially

     

       365
       365
       +
           - Can be extended using {!Doc} module functions

     

       366
       366
       +
           

     

       367
       367
       +
           @param creator Name of the creating application (e.g., "MyGPS App v1.0")

     

       368
       368
       +
           @return Empty GPX document ready for data addition

     

       369
       369
       +
           

     

       370
       370
       +
           Example:

     

       371
       371
       +
           {[

     

       372
       372
       +
             let gpx = make_gpx ~creator:"MyTracker v2.1" in

     

       373
       373
       +
             let gpx = Doc.add_waypoint gpx some_waypoint in

     

       374
       374
       +
             let gpx = Doc.add_track gpx some_track in

     

       375
       375
       +
             (* gpx now contains waypoints and tracks *)

     

       376
       376
       +
           ]} *)

     

       377
       377
       +
       val make_gpx : creator:string -> t

     

       358
       378
        
       

     

       359
       359
       -
       (** Streaming XML parser *)

     

       360
       360
       -
       module Parser = Parser

     

       379
       379
       +
       (** Create an empty GPX document with the required creator field.

     

       380
       380
       +
           

     

       381
       381
       +
           Alias for {!make_gpx} provided for consistency with module naming patterns.

     

       382
       382
       +
           Creates a document with no GPS data that can be populated using the

     

       383
       383
       +
           {!Doc} module functions.

     

       384
       384
       +
           

     

       385
       385
       +
           @param creator Name of the creating application

     

       386
       386
       +
           @return Empty GPX document

     

       387
       387
       +
           

     

       388
       388
       +
           Example:

     

       389
       389
       +
           {[

     

       390
       390
       +
             let gpx = empty ~creator:"GPS Logger" in

     

       391
       391
       +
             assert (List.length (Doc.waypoints gpx) = 0);

     

       392
       392
       +
             assert (List.length (Doc.tracks gpx) = 0);

     

       393
       393
       +
             assert (Doc.creator gpx = "GPS Logger");

     

       394
       394
       +
           ]} *)

     

       395
       395
       +
       val empty : creator:string -> t

     

       361
       396
        
       

     

       362
       362
       -
       (** Streaming XML writer *) 

     

       363
       363
       -
       module Writer = Writer

     

       397
       397
       +
       (** {1 Common Patterns and Best Practices}

     

       398
       398
       +
           

     

       399
       399
       +
           {2 Reading GPX Files}

     

       400
       400
       +
           

     

       401
       401
       +
           The most common use case is reading existing GPX files:

     

       402
       402
       +
           {[

     

       403
       403
       +
             (* From a file using platform-specific modules *)

     

       404
       404
       +
             match Gpx_unix.read "track.gpx" with

     

       405
       405
       +
             | Ok gpx -> process_gpx gpx

     

       406
       406
       +
             | Error e -> handle_error e

     

       407
       407
       +
             

     

       408
       408
       +
             (* From a string *)

     

       409
       409
       +
             match parse_string ~validate:true gpx_content with

     

       410
       410
       +
             | Ok gpx -> process_gpx gpx

     

       411
       411
       +
             | Error e -> handle_error e

     

       412
       412
       +
           ]}

     

       413
       413
       +
           

     

       414
       414
       +
           {2 Creating GPX Files}

     

       415
       415
       +
           

     

       416
       416
       +
           To create new GPX files with waypoints:

     

       417
       417
       +
           {[

     

       418
       418
       +
             (* Create coordinates *)

     

       419
       419
       +
             let lat = Coordinate.latitude 37.7749 |> Result.get_ok in

     

       420
       420
       +
             let lon = Coordinate.longitude (-122.4194) |> Result.get_ok in

     

       421
       421
       +
             

     

       422
       422
       +
             (* Create waypoint *)

     

       423
       423
       +
             let waypoint = Waypoint.make lat lon

     

       424
       424
       +
               |> Waypoint.with_name "Golden Gate"

     

       425
       425
       +
               |> Waypoint.with_description "Famous San Francisco bridge" in

     

       426
       426
       +
             

     

       427
       427
       +
             (* Create document *)

     

       428
       428
       +
             let gpx = make_gpx ~creator:"My App v1.0"

     

       429
       429
       +
               |> Doc.add_waypoint waypoint in

     

       430
       430
       +
             

     

       431
       431
       +
             (* Write to file *)

     

       432
       432
       +
             match Gpx_unix.write "output.gpx" gpx with

     

       433
       433
       +
             | Ok () -> print_endline "File written successfully"

     

       434
       434
       +
             | Error e -> Printf.eprintf "Write error: %s\n" (Error.to_string e)

     

       435
       435
       +
           ]}

     

       436
       436
       +
           

     

       437
       437
       +
           {2 Working with Tracks}

     

       438
       438
       +
           

     

       439
       439
       +
           Tracks represent recorded GPS traces with timestamped points:

     

       440
       440
       +
           {[

     

       441
       441
       +
             (* Create track points with timestamps *)

     

       442
       442
       +
             let points = List.map (fun (lat_f, lon_f, time) ->

     

       443
       443
       +
               let lat = Coordinate.latitude lat_f |> Result.get_ok in

     

       444
       444
       +
               let lon = Coordinate.longitude lon_f |> Result.get_ok in

     

       445
       445
       +
               Waypoint.make lat lon |> Waypoint.with_time (Some time)

     

       446
       446
       +
             ) gps_data in

     

       447
       447
       +
             

     

       448
       448
       +
             (* Create track segment *)

     

       449
       449
       +
             let segment = Track.Segment.make points in

     

       450
       450
       +
             

     

       451
       451
       +
             (* Create track *)

     

       452
       452
       +
             let track = Track.make ~name:"Morning Run"

     

       453
       453
       +
               |> Track.add_segment segment in

     

       454
       454
       +
             

     

       455
       455
       +
             (* Add to document *)

     

       456
       456
       +
             let gpx = make_gpx ~creator:"Fitness App"

     

       457
       457
       +
               |> Doc.add_track track

     

       458
       458
       +
           ]}

     

       459
       459
       +
           

     

       460
       460
       +
           {2 Coordinate Systems and Units}

     

       461
       461
       +
           

     

       462
       462
       +
           - All coordinates use WGS84 datum (World Geodetic System 1984)

     

       463
       463
       +
           - Latitude ranges from -90.0 (South Pole) to +90.0 (North Pole)  

     

       464
       464
       +
           - Longitude ranges from -180.0 to +180.0 degrees

     

       465
       465
       +
           - Elevations are in meters above mean sea level

     

       466
       466
       +
           - Times use RFC 3339 format (ISO 8601 subset)

     

       467
       467
       +
           

     

       468
       468
       +
           {2 Validation Recommendations}

     

       469
       469
       +
           

     

       470
       470
       +
           - Always validate when parsing untrusted GPX data

     

       471
       471
       +
           - Validate before writing to catch data consistency issues

     

       472
       472
       +
           - Handle both errors and warnings appropriately

     

       473
       473
       +
           - Use {!val:is_valid} for quick checks, {!validate_gpx} for detailed analysis

     

       474
       474
       +
           

     

       475
       475
       +
           {2 Performance Considerations}

     

       476
       476
       +
           

     

       477
       477
       +
           - The library uses streaming XML parsing for memory efficiency

     

       478
       478
       +
           - Large GPX files with many track points are handled efficiently

     

       479
       479
       +
           - Coordinate validation occurs at construction time

     

       480
       480
       +
           - Consider using platform-specific modules ({!Gpx_unix}, [Gpx_eio]) for file I/O

     

       481
       481
       +
           

     

       482
       482
       +
           {2 Extension Support}

     

       483
       483
       +
           

     

       484
       484
       +
           The library supports GPX extensions for custom data:

     

       485
       485
       +
           {[

     

       486
       486
       +
             (* Create extension *)

     

       487
       487
       +
             let ext = Extension.make_text

     

       488
       488
       +
               ~name:"temperature" 

     

       489
       489
       +
               ~namespace:"http://example.com/weather"

     

       490
       490
       +
               "25.5" in

     

       491
       491
       +
             

     

       492
       492
       +
             (* Add to waypoint *)

     

       493
       493
       +
             let waypoint = Waypoint.make lat lon

     

       494
       494
       +
               |> Waypoint.add_extensions [ext]

     

       495
       495
       +
           ]} *)

     

       364
       496
        
       

     

       365
       365
       -
       (** Validation engine *)

     

       366
       366
       -
       module Validate = Validate
     

       497
       497
       +
       (** {1 Related Modules and Libraries}

     

       498
       498
       +
           

     

       499
       499
       +
           This core module provides the foundation. For complete applications, consider:

     

       500
       500
       +
           

     

       501
       501
       +
           - {!Gpx_unix}: File I/O operations using standard Unix libraries

     

       502
       502
       +
           - {!Gpx_eio}: Concurrent file I/O using the Eio effects library  

     

       503
       503
       +
           - {{:https://erratique.ch/software/xmlm}Xmlm}: Underlying XML processing library

     

       504
       504
       +
           - {{:https://erratique.ch/software/ptime}Ptime}: Time representation used for timestamps

     

       505
       505
       +
           

     

       506
       506
       +
           {2 External Links}

     

       507
       507
       +
           

     

       508
       508
       +
           - {{:https://www.topografix.com/gpx.asp}Official GPX specification}

     

       509
       509
       +
           - {{:https://www.topografix.com/GPX/1/1/gpx.xsd}GPX 1.1 XML Schema}

     

       510
       510
       +
           - {{:https://en.wikipedia.org/wiki/GPS_Exchange_Format}GPX Format on Wikipedia}

     

       511
       511
       +
           - {{:https://en.wikipedia.org/wiki/World_Geodetic_System}WGS84 Coordinate System} *)

+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 href t = t.href

     

       31
       31
       +
       

     

       32
       32
       +
       (** Get optional text from link *)

     

       33
       33
       +
       let text t = t.text

     

       34
       34
       +
       

     

       35
       35
       +
       (** Get optional type from link *)

     

       36
       36
       +
       let type_ t = t.type_

     

       37
       37
       +
       

     

       38
       38
       +
       (** Update text *)

     

       39
       39
       +
       let with_text t text = { t with text = Some text }

     

       40
       40
       +
       

     

       41
       41
       +
       (** Update type *)

     

       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 person_name (p : person) = p.name

     

       69
       69
       +
       

     

       70
       70
       +
       (** Get person email *)

     

       71
       71
       +
       let person_email (p : person) = p.email

     

       72
       72
       +
       

     

       73
       73
       +
       (** Get person link *)

     

       74
       74
       +
       let 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 copyright_author (c : copyright) = c.author

     

       103
       103
       +
       

     

       104
       104
       +
       (** Get copyright year *)

     

       105
       105
       +
       let copyright_year (c : copyright) = c.year

     

       106
       106
       +
       

     

       107
       107
       +
       (** Get copyright license *)

     

       108
       108
       +
       let 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

+101

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 href : t -> string

     

       34
       34
       +
       

     

       35
       35
       +
       (** Get optional text from link *)

     

       36
       36
       +
       val text : t -> string option

     

       37
       37
       +
       

     

       38
       38
       +
       (** Get optional type from link *)

     

       39
       39
       +
       val type_ : t -> string option

     

       40
       40
       +
       

     

       41
       41
       +
       (** Update text *)

     

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

     

       43
       43
       +
       

     

       44
       44
       +
       (** Update type *)

     

       45
       45
       +
       val with_type : t -> string -> t

     

       46
       46
       +
       

     

       47
       47
       +
       

     

       48
       48
       +
       (** Compare links *)

     

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

     

       50
       50
       +
       

     

       51
       51
       +
       (** Test link equality *)

     

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

     

       53
       53
       +
       

     

       54
       54
       +
       (** Pretty print link *)

     

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

     

       56
       56
       +
       

     

       57
       57
       +
       (** {2 Person Operations} *)

     

       58
       58
       +
       

     

       59
       59
       +
       (** Create person information *)

     

       60
       60
       +
       val make_person : ?name:string -> ?email:string -> ?link:t -> unit -> person

     

       61
       61
       +
       

     

       62
       62
       +
       (** Get person name *)

     

       63
       63
       +
       val person_name : person -> string option

     

       64
       64
       +
       

     

       65
       65
       +
       (** Get person email *)

     

       66
       66
       +
       val person_email : person -> string option

     

       67
       67
       +
       

     

       68
       68
       +
       (** Get person link *)

     

       69
       69
       +
       val person_link : person -> t option

     

       70
       70
       +
       

     

       71
       71
       +
       (** Compare persons *)

     

       72
       72
       +
       val compare_person : person -> person -> int

     

       73
       73
       +
       

     

       74
       74
       +
       (** Test person equality *)

     

       75
       75
       +
       val equal_person : person -> person -> bool

     

       76
       76
       +
       

     

       77
       77
       +
       (** Pretty print person *)

     

       78
       78
       +
       val pp_person : Format.formatter -> person -> unit

     

       79
       79
       +
       

     

       80
       80
       +
       (** {2 Copyright Operations} *)

     

       81
       81
       +
       

     

       82
       82
       +
       (** Create copyright information *)

     

       83
       83
       +
       val make_copyright : author:string -> ?year:int -> ?license:string -> unit -> copyright

     

       84
       84
       +
       

     

       85
       85
       +
       (** Get copyright author *)

     

       86
       86
       +
       val copyright_author : copyright -> string

     

       87
       87
       +
       

     

       88
       88
       +
       (** Get copyright year *)

     

       89
       89
       +
       val copyright_year : copyright -> int option

     

       90
       90
       +
       

     

       91
       91
       +
       (** Get copyright license *)

     

       92
       92
       +
       val copyright_license : copyright -> string option

     

       93
       93
       +
       

     

       94
       94
       +
       (** Compare copyrights *)

     

       95
       95
       +
       val compare_copyright : copyright -> copyright -> int

     

       96
       96
       +
       

     

       97
       97
       +
       (** Test copyright equality *)

     

       98
       98
       +
       val equal_copyright : copyright -> copyright -> bool

     

       99
       99
       +
       

     

       100
       100
       +
       (** Pretty print copyright *)

     

       101
       101
       +
       val pp_copyright : Format.formatter -> copyright -> unit

+183

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 min_coords t = Coordinate.make t.minlat t.minlon

     

       49
       49
       +
         let max_coords t = Coordinate.make t.maxlat t.maxlon

     

       50
       50
       +
       

     

       51
       51
       +
         (** Get all bounds as tuple *)

     

       52
       52
       +
         let 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.lat coord in

     

       57
       57
       +
           let lon = Coordinate.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 name t = t.name

     

       115
       115
       +
       

     

       116
       116
       +
       (** Get description *)  

     

       117
       117
       +
       let description t = t.desc

     

       118
       118
       +
       

     

       119
       119
       +
       (** Get author *)

     

       120
       120
       +
       let author t = t.author

     

       121
       121
       +
       

     

       122
       122
       +
       (** Get copyright *)

     

       123
       123
       +
       let copyright t = t.copyright

     

       124
       124
       +
       

     

       125
       125
       +
       (** Get links *)

     

       126
       126
       +
       let links t = t.links

     

       127
       127
       +
       

     

       128
       128
       +
       (** Get time *)

     

       129
       129
       +
       let time t = t.time

     

       130
       130
       +
       

     

       131
       131
       +
       (** Get keywords *)

     

       132
       132
       +
       let keywords t = t.keywords

     

       133
       133
       +
       

     

       134
       134
       +
       (** Get bounds *)

     

       135
       135
       +
       let bounds_opt t = t.bounds

     

       136
       136
       +
       

     

       137
       137
       +
       (** Get extensions *)

     

       138
       138
       +
       let extensions t = t.extensions

     

       139
       139
       +
       

     

       140
       140
       +
       (** Update name *)

     

       141
       141
       +
       let with_name t name = { t with name = Some name }

     

       142
       142
       +
       

     

       143
       143
       +
       (** Update description *)

     

       144
       144
       +
       let with_description t desc = { t with desc = Some desc }

     

       145
       145
       +
       

     

       146
       146
       +
       (** Update keywords *)

     

       147
       147
       +
       let with_keywords t keywords = { t with keywords = Some keywords }

     

       148
       148
       +
       

     

       149
       149
       +
       (** Update time *)

     

       150
       150
       +
       let with_time t time = { t with time }

     

       151
       151
       +
       

     

       152
       152
       +
       (** Update bounds *)

     

       153
       153
       +
       let with_bounds t bounds = { t with bounds = Some bounds }

     

       154
       154
       +
       

     

       155
       155
       +
       (** Update author *)

     

       156
       156
       +
       let with_author t author = { t with author = Some author }

     

       157
       157
       +
       

     

       158
       158
       +
       (** Update copyright *)

     

       159
       159
       +
       let with_copyright t copyright = { t with copyright = Some copyright }

     

       160
       160
       +
       

     

       161
       161
       +
       (** Add link *)

     

       162
       162
       +
       let add_link t link = { t with links = link :: t.links }

     

       163
       163
       +
       

     

       164
       164
       +
       (** Add extensions *)

     

       165
       165
       +
       let add_extensions t extensions = { t with extensions = extensions @ t.extensions }

     

       166
       166
       +
       

     

       167
       167
       +
       (** Compare metadata *)

     

       168
       168
       +
       let compare t1 t2 =

     

       169
       169
       +
         let name_cmp = Option.compare String.compare t1.name t2.name in

     

       170
       170
       +
         if name_cmp <> 0 then name_cmp

     

       171
       171
       +
         else

     

       172
       172
       +
           let desc_cmp = Option.compare String.compare t1.desc t2.desc in

     

       173
       173
       +
           if desc_cmp <> 0 then desc_cmp

     

       174
       174
       +
           else Option.compare Ptime.compare t1.time t2.time

     

       175
       175
       +
       

     

       176
       176
       +
       (** Test metadata equality *)

     

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

     

       178
       178
       +
       

     

       179
       179
       +
       (** Pretty print metadata *)

     

       180
       180
       +
       let pp ppf t =

     

       181
       181
       +
         match t.name with

     

       182
       182
       +
         | Some name -> Format.fprintf ppf "\"%s\"" name

     

       183
       183
       +
         | None -> Format.fprintf ppf "(unnamed)"

+132

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 min_coords : t -> Coordinate.t

     

       38
       38
       +
       

     

       39
       39
       +
         (** Get maximum corner coordinates *)

     

       40
       40
       +
         val max_coords : t -> Coordinate.t

     

       41
       41
       +
       

     

       42
       42
       +
         (** Get all bounds as tuple *)

     

       43
       43
       +
         val 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 name : t -> string option

     

       71
       71
       +
       

     

       72
       72
       +
       (** Get description *)  

     

       73
       73
       +
       val description : t -> string option

     

       74
       74
       +
       

     

       75
       75
       +
       (** Get author *)

     

       76
       76
       +
       val author : t -> Link.person option

     

       77
       77
       +
       

     

       78
       78
       +
       (** Get copyright *)

     

       79
       79
       +
       val copyright : t -> Link.copyright option

     

       80
       80
       +
       

     

       81
       81
       +
       (** Get links *)

     

       82
       82
       +
       val links : t -> Link.t list

     

       83
       83
       +
       

     

       84
       84
       +
       (** Get time *)

     

       85
       85
       +
       val time : t -> Ptime.t option

     

       86
       86
       +
       

     

       87
       87
       +
       (** Get keywords *)

     

       88
       88
       +
       val keywords : t -> string option

     

       89
       89
       +
       

     

       90
       90
       +
       (** Get bounds *)

     

       91
       91
       +
       val bounds_opt : t -> bounds option

     

       92
       92
       +
       

     

       93
       93
       +
       (** Get extensions *)

     

       94
       94
       +
       val extensions : t -> Extension.t list

     

       95
       95
       +
       

     

       96
       96
       +
       (** Functional operations for building metadata *)

     

       97
       97
       +
       

     

       98
       98
       +
       (** Update name *)

     

       99
       99
       +
       val with_name : t -> string -> t

     

       100
       100
       +
       

     

       101
       101
       +
       (** Update description *)

     

       102
       102
       +
       val with_description : t -> string -> t

     

       103
       103
       +
       

     

       104
       104
       +
       (** Update keywords *)

     

       105
       105
       +
       val with_keywords : t -> string -> t

     

       106
       106
       +
       

     

       107
       107
       +
       (** Update time *)

     

       108
       108
       +
       val with_time : t -> Ptime.t option -> t

     

       109
       109
       +
       

     

       110
       110
       +
       (** Update bounds *)

     

       111
       111
       +
       val with_bounds : t -> bounds -> t

     

       112
       112
       +
       

     

       113
       113
       +
       (** Update author *)

     

       114
       114
       +
       val with_author : t -> Link.person -> t

     

       115
       115
       +
       

     

       116
       116
       +
       (** Update copyright *)

     

       117
       117
       +
       val with_copyright : t -> Link.copyright -> t

     

       118
       118
       +
       

     

       119
       119
       +
       (** Add link *)

     

       120
       120
       +
       val add_link : t -> Link.t -> t

     

       121
       121
       +
       

     

       122
       122
       +
       (** Add extensions *)

     

       123
       123
       +
       val add_extensions : t -> Extension.t list -> t

     

       124
       124
       +
       

     

       125
       125
       +
       (** Compare metadata *)

     

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

     

       127
       127
       +
       

     

       128
       128
       +
       (** Test metadata equality *)

     

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

     

       130
       130
       +
       

     

       131
       131
       +
       (** Pretty print metadata *)

     

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

+226 -106

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)

     

       113
       113
       +
                 | None -> loop wpt)

     

       114
       114
       +
              | "hdop" ->

     

       115
       115
       +
                let* text = parse_text_content parser in

     

       116
       116
       +
                (match parse_float_opt text with

     

       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)

     

       115
       123
        
                 | None -> loop wpt)

     

       116
       116
       -
              | "hdop" | "vdop" | "pdop" ->

     

       124
       124
       +
              | "pdop" ->

     

       117
       125
        
                let* text = parse_text_content parser in

     

       118
       126
        
                (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)

     

       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

     

       293
       293
       +
         let gpx = Doc.empty ~creator in

     

       291
       294
        
         parse_gpx_elements parser { gpx with version }

     

       292
       295
        
       

     

       293
       296
        
       and parse_gpx_elements parser 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 (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 (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 (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 (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 (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 _ ->

     
···

       327
       327
        
         in

     

       328
       328
        
         loop gpx

     

       329
       329
        
       

     

       330
       330
       +
       and parse_author parser =

     

       331
       331
       +
         let rec loop name email link =

     

       332
       332
       +
           match Xmlm.input parser.input with

     

       333
       333
       +
           | `El_start ((_, element_name), attrs) ->

     

       334
       334
       +
             parser.current_element <- element_name :: parser.current_element;

     

       335
       335
       +
             (match element_name with

     

       336
       336
       +
              | "name" ->

     

       337
       337
       +
                let* text = parse_text_content parser in

     

       338
       338
       +
                loop (Some text) email link

     

       339
       339
       +
              | "email" ->

     

       340
       340
       +
                let* email_addr = parse_email_attrs attrs in

     

       341
       341
       +
                let* _ = skip_element parser in

     

       342
       342
       +
                loop name (Some email_addr) link  

     

       343
       343
       +
              | "link" ->

     

       344
       344
       +
                let* parsed_link = parse_link parser attrs in

     

       345
       345
       +
                loop name email (Some parsed_link)

     

       346
       346
       +
              | _ ->

     

       347
       347
       +
                let* _ = skip_element parser in

     

       348
       348
       +
                loop name email link)

     

       349
       349
       +
           | `El_end ->

     

       350
       350
       +
             parser.current_element <- List.tl parser.current_element;

     

       351
       351
       +
             Ok (Link.make_person ?name ?email ?link ())

     

       352
       352
       +
           | `Data _ ->

     

       353
       353
       +
             loop name email link

     

       354
       354
       +
           | `Dtd _ ->

     

       355
       355
       +
             loop name email link

     

       356
       356
       +
         in

     

       357
       357
       +
         loop None None None

     

       358
       358
       +
       

     

       359
       359
       +
       and parse_email_attrs attrs =

     

       360
       360
       +
         let get_attr name =

     

       361
       361
       +
           List.find_map (fun ((_, attr_name), value) ->

     

       362
       362
       +
             if attr_name = name then Some value else None

     

       363
       363
       +
           ) attrs

     

       364
       364
       +
         in

     

       365
       365
       +
         match get_attr "id", get_attr "domain" with

     

       366
       366
       +
         | Some id, Some domain -> Ok (id ^ "@" ^ domain)

     

       367
       367
       +
         | _ -> Error (Error.invalid_xml "Missing email id or domain attributes")

     

       368
       368
       +
       

     

       369
       369
       +
       and parse_copyright parser attrs =

     

       370
       370
       +
         let get_attr name =

     

       371
       371
       +
           List.find_map (fun ((_, attr_name), value) ->

     

       372
       372
       +
             if attr_name = name then Some value else None

     

       373
       373
       +
           ) attrs

     

       374
       374
       +
         in

     

       375
       375
       +
         let author = get_attr "author" in

     

       376
       376
       +
         let rec loop year license =

     

       377
       377
       +
           match Xmlm.input parser.input with

     

       378
       378
       +
           | `El_start ((_, element_name), _) ->

     

       379
       379
       +
             parser.current_element <- element_name :: parser.current_element;

     

       380
       380
       +
             (match element_name with

     

       381
       381
       +
              | "year" ->

     

       382
       382
       +
                let* text = parse_text_content parser in

     

       383
       383
       +
                (match parse_int_opt text with

     

       384
       384
       +
                 | Some y -> loop (Some y) license

     

       385
       385
       +
                 | None -> loop year license)

     

       386
       386
       +
              | "license" ->

     

       387
       387
       +
                let* text = parse_text_content parser in

     

       388
       388
       +
                loop year (Some text)

     

       389
       389
       +
              | _ ->

     

       390
       390
       +
                let* _ = skip_element parser in

     

       391
       391
       +
                loop year license)

     

       392
       392
       +
           | `El_end ->

     

       393
       393
       +
             parser.current_element <- List.tl parser.current_element;

     

       394
       394
       +
             (match author with

     

       395
       395
       +
              | Some auth -> Ok (Link.make_copyright ~author:auth ?year ?license ())

     

       396
       396
       +
              | None -> Error (Error.invalid_xml "Missing copyright author attribute"))

     

       397
       397
       +
           | `Data _ ->

     

       398
       398
       +
             loop year license

     

       399
       399
       +
           | `Dtd _ ->

     

       400
       400
       +
             loop year license

     

       401
       401
       +
         in

     

       402
       402
       +
         loop None None

     

       403
       403
       +
       

     

       404
       404
       +
       and parse_bounds parser attrs =

     

       405
       405
       +
         let get_attr name =

     

       406
       406
       +
           List.find_map (fun ((_, attr_name), value) ->

     

       407
       407
       +
             if attr_name = name then Some value else None

     

       408
       408
       +
           ) attrs

     

       409
       409
       +
         in

     

       410
       410
       +
         let minlat_str = get_attr "minlat" in

     

       411
       411
       +
         let minlon_str = get_attr "minlon" in

     

       412
       412
       +
         let maxlat_str = get_attr "maxlat" in

     

       413
       413
       +
         let maxlon_str = get_attr "maxlon" in

     

       414
       414
       +
         

     

       415
       415
       +
         (* Skip content since bounds is a self-closing element *)

     

       416
       416
       +
         let rec skip_bounds_content () =

     

       417
       417
       +
           match Xmlm.input parser.input with

     

       418
       418
       +
           | `El_end -> 

     

       419
       419
       +
               parser.current_element <- List.tl parser.current_element;

     

       420
       420
       +
               Ok ()

     

       421
       421
       +
           | `Data _ -> skip_bounds_content ()

     

       422
       422
       +
           | _ -> skip_bounds_content ()

     

       423
       423
       +
         in

     

       424
       424
       +
         let* () = skip_bounds_content () in

     

       425
       425
       +
         

     

       426
       426
       +
         match minlat_str, minlon_str, maxlat_str, maxlon_str with

     

       427
       427
       +
         | Some minlat, Some minlon, Some maxlat, Some maxlon ->

     

       428
       428
       +
             (match 

     

       429
       429
       +
                Float.of_string_opt minlat, Float.of_string_opt minlon,

     

       430
       430
       +
                Float.of_string_opt maxlat, Float.of_string_opt maxlon

     

       431
       431
       +
              with

     

       432
       432
       +
              | Some minlat_f, Some minlon_f, Some maxlat_f, Some maxlon_f ->

     

       433
       433
       +
                  (match Metadata.Bounds.make_from_floats ~minlat:minlat_f ~minlon:minlon_f ~maxlat:maxlat_f ~maxlon:maxlon_f with

     

       434
       434
       +
                   | Ok bounds -> Ok bounds

     

       435
       435
       +
                   | Error msg -> Error (Error.invalid_xml ("Invalid bounds: " ^ msg)))

     

       436
       436
       +
              | _ -> Error (Error.invalid_xml ("Invalid bounds coordinates")))

     

       437
       437
       +
         | _ -> Error (Error.invalid_xml ("Missing bounds attributes"))

     

       438
       438
       +
       

     

       330
       439
        
       and parse_metadata parser =

     

       331
       331
       -
         let metadata = empty_metadata in

     

       332
       332
       -
         let rec loop (metadata : metadata) =

     

       440
       440
       +
         let metadata = Metadata.empty in

     

       441
       441
       +
         let rec loop metadata =

     

       333
       442
        
           match Xmlm.input parser.input with

     

       334
       443
        
           | `El_start ((_, name), attrs) ->

     

       335
       444
        
             parser.current_element <- name :: parser.current_element;

     

       336
       445
        
             (match name with

     

       337
       446
        
              | "name" ->

     

       338
       447
        
                let* text = parse_text_content parser in

     

       339
       339
       -
                loop { metadata with name = Some text }

     

       448
       448
       +
                loop (Metadata.with_name metadata text)

     

       340
       449
        
              | "desc" ->

     

       341
       450
        
                let* text = parse_text_content parser in

     

       342
       342
       -
                loop { metadata with desc = Some text }

     

       451
       451
       +
                loop (Metadata.with_description metadata text)

     

       343
       452
        
              | "keywords" ->

     

       344
       453
        
                let* text = parse_text_content parser in

     

       345
       345
       -
                loop { metadata with keywords = Some text }

     

       454
       454
       +
                loop (Metadata.with_keywords metadata text)

     

       346
       455
        
              | "time" ->

     

       347
       456
        
                let* text = parse_text_content parser in

     

       348
       348
       -
                loop { metadata with time = parse_time text }

     

       457
       457
       +
                loop (Metadata.with_time metadata (parse_time text))

     

       349
       458
        
              | "link" ->

     

       350
       459
        
                let* link = parse_link parser attrs in

     

       351
       351
       -
                loop { metadata with links = link :: metadata.links }

     

       460
       460
       +
                loop (Metadata.add_link metadata link)

     

       461
       461
       +
              | "author" ->

     

       462
       462
       +
                let* author = parse_author parser in

     

       463
       463
       +
                loop (Metadata.with_author metadata author)

     

       464
       464
       +
              | "copyright" ->

     

       465
       465
       +
                let* copyright = parse_copyright parser attrs in

     

       466
       466
       +
                loop (Metadata.with_copyright metadata copyright)

     

       467
       467
       +
              | "bounds" ->

     

       468
       468
       +
                let* bounds = parse_bounds parser attrs in

     

       469
       469
       +
                loop (Metadata.with_bounds metadata bounds)

     

       352
       470
        
              | "extensions" ->

     

       353
       471
        
                let* extensions = parse_extensions parser in

     

       354
       354
       -
                loop { metadata with extensions = extensions @ metadata.extensions }

     

       472
       472
       +
                loop (Metadata.add_extensions metadata extensions)

     

       355
       473
        
              | _ ->

     

       356
       474
        
                let* _ = skip_element parser in

     

       357
       475
        
                loop metadata)

     

       358
       476
        
           | `El_end ->

     

       359
       477
        
             parser.current_element <- List.tl parser.current_element;

     

       360
       360
       -
             Ok { metadata with links = List.rev metadata.links }

     

       478
       478
       +
             Ok metadata

     

       361
       479
        
           | `Data _ ->

     

       362
       480
        
             loop metadata

     

       363
       481
        
           | `Dtd _ ->

     
···

       366
       484
        
         loop metadata

     

       367
       485
        
       

     

       368
       486
        
       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) =

     

       487
       487
       +
         let route = Route.empty in

     

       488
       488
       +
         let rec loop route =

     

       374
       489
        
           match Xmlm.input parser.input with

     

       375
       490
        
           | `El_start ((_, name), attrs) ->

     

       376
       491
        
             parser.current_element <- name :: parser.current_element;

     

       377
       492
        
             (match name with

     

       378
       493
        
              | "name" ->

     

       379
       494
        
                let* text = parse_text_content parser in

     

       380
       380
       -
                loop { route with name = Some text }

     

       495
       495
       +
                loop (Route.with_name route text)

     

       381
       496
        
              | "cmt" ->

     

       382
       497
        
                let* text = parse_text_content parser in

     

       383
       383
       -
                loop { route with cmt = Some text }

     

       498
       498
       +
                loop (Route.with_comment route text)

     

       384
       499
        
              | "desc" ->

     

       385
       500
        
                let* text = parse_text_content parser in

     

       386
       386
       -
                loop { route with desc = Some text }

     

       501
       501
       +
                loop (Route.with_description route text)

     

       387
       502
        
              | "src" ->

     

       388
       503
        
                let* text = parse_text_content parser in

     

       389
       389
       -
                loop { route with src = Some text }

     

       504
       504
       +
                loop (Route.with_source route text)

     

       390
       505
        
              | "number" ->

     

       391
       506
        
                let* text = parse_text_content parser in

     

       392
       507
        
                (match parse_int_opt text with

     

       393
       393
       -
                 | Some n -> loop { route with number = Some n }

     

       508
       508
       +
                 | Some n -> loop (Route.with_number route n)

     

       394
       509
        
                 | None -> loop route)

     

       395
       510
        
              | "type" ->

     

       396
       511
        
                let* text = parse_text_content parser in

     

       397
       397
       -
                loop { route with type_ = Some text }

     

       512
       512
       +
                loop (Route.with_type route text)

     

       398
       513
        
              | "rtept" ->

     

       399
       514
        
                let* (lat, lon) = parse_coordinates attrs "rtept" in

     

       400
       515
        
                let* rtept = parse_waypoint_data parser lat lon in

     

       401
       401
       -
                loop { route with rtepts = rtept :: route.rtepts }

     

       516
       516
       +
                loop (Route.add_point route rtept)

     

       402
       517
        
              | "link" ->

     

       403
       518
        
                let* link = parse_link parser attrs in

     

       404
       404
       -
                loop { route with links = link :: route.links }

     

       519
       519
       +
                loop (Route.add_link route link)

     

       405
       520
        
              | "extensions" ->

     

       406
       521
        
                let* extensions = parse_extensions parser in

     

       407
       407
       -
                loop { route with extensions = extensions @ route.extensions }

     

       522
       522
       +
                loop (Route.add_extensions route extensions)

     

       408
       523
        
              | _ ->

     

       409
       524
        
                let* _ = skip_element parser in

     

       410
       525
        
                loop route)

     

       411
       526
        
           | `El_end ->

     

       412
       527
        
             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 }

     

       528
       528
       +
             Ok route

     

       416
       529
        
           | `Data _ ->

     

       417
       530
        
             loop route

     

       418
       531
        
           | `Dtd _ ->

     
···

       421
       534
        
         loop route

     

       422
       535
        
       

     

       423
       536
        
       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

     

       537
       537
       +
         let track = Track.empty in

     

       428
       538
        
         let rec loop track =

     

       429
       539
        
           match Xmlm.input parser.input with

     

       430
       540
        
           | `El_start ((_, name), attrs) ->

     
···

       432
       542
        
             (match name with

     

       433
       543
        
              | "name" ->

     

       434
       544
        
                let* text = parse_text_content parser in

     

       435
       435
       -
                loop { track with name = Some text }

     

       545
       545
       +
                loop (Track.with_name track text)

     

       436
       546
        
              | "cmt" ->

     

       437
       547
        
                let* text = parse_text_content parser in

     

       438
       438
       -
                loop { track with cmt = Some text }

     

       548
       548
       +
                loop (Track.with_comment track text)

     

       439
       549
        
              | "desc" ->

     

       440
       550
        
                let* text = parse_text_content parser in

     

       441
       441
       -
                loop { track with desc = Some text }

     

       551
       551
       +
                loop (Track.with_description track text)

     

       442
       552
        
              | "src" ->

     

       443
       553
        
                let* text = parse_text_content parser in

     

       444
       444
       -
                loop { track with src = Some text }

     

       554
       554
       +
                loop (Track.with_source track text)

     

       445
       555
        
              | "number" ->

     

       446
       556
        
                let* text = parse_text_content parser in

     

       447
       557
        
                (match parse_int_opt text with

     

       448
       448
       -
                 | Some n -> loop { track with number = Some n }

     

       558
       558
       +
                 | Some n -> loop (Track.with_number track n)

     

       449
       559
        
                 | None -> loop track)

     

       450
       560
        
              | "type" ->

     

       451
       561
        
                let* text = parse_text_content parser in

     

       452
       452
       -
                loop { track with type_ = Some text }

     

       562
       562
       +
                loop (Track.with_type track text)

     

       453
       563
        
              | "trkseg" ->

     

       454
       564
        
                let* trkseg = parse_track_segment parser in

     

       455
       455
       -
                loop { track with trksegs = trkseg :: track.trksegs }

     

       565
       565
       +
                loop (Track.add_segment track trkseg)

     

       456
       566
        
              | "link" ->

     

       457
       567
        
                let* link = parse_link parser attrs in

     

       458
       458
       -
                loop { track with links = link :: track.links }

     

       568
       568
       +
                loop (Track.add_link track link)

     

       459
       569
        
              | "extensions" ->

     

       460
       570
        
                let* extensions = parse_extensions parser in

     

       461
       461
       -
                loop { track with extensions = extensions @ track.extensions }

     

       571
       571
       +
                loop (Track.add_extensions track extensions)

     

       462
       572
        
              | _ ->

     

       463
       573
        
                let* _ = skip_element parser in

     

       464
       574
        
                loop track)

     

       465
       575
        
           | `El_end ->

     

       466
       576
        
             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 }

     

       577
       577
       +
             Ok track

     

       470
       578
        
           | `Data _ ->

     

       471
       579
        
             loop track

     

       472
       580
        
           | `Dtd _ ->

     
···

       475
       583
        
         loop track

     

       476
       584
        
       

     

       477
       585
        
       and parse_track_segment parser =

     

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

     

       586
       586
       +
         let trkseg = Track.Segment.empty in

     

       479
       587
        
         let rec loop trkseg =

     

       480
       588
        
           match Xmlm.input parser.input with

     

       481
       589
        
           | `El_start ((_, name), attrs) ->

     
···

       484
       592
        
              | "trkpt" ->

     

       485
       593
        
                let* (lat, lon) = parse_coordinates attrs "trkpt" in

     

       486
       594
        
                let* trkpt = parse_waypoint_data parser lat lon in

     

       487
       487
       -
                loop { trkseg with trkpts = trkpt :: trkseg.trkpts }

     

       595
       595
       +
                loop (Track.Segment.add_point trkseg trkpt)

     

       488
       596
        
              | "extensions" ->

     

       489
       489
       -
                let* extensions = parse_extensions parser in

     

       490
       490
       -
                loop { trkseg with extensions = extensions @ trkseg.extensions }

     

       597
       597
       +
                let* _ = parse_extensions parser in

     

       598
       598
       +
                loop trkseg

     

       491
       599
        
              | _ ->

     

       492
       600
        
                let* _ = skip_element parser in

     

       493
       601
        
                loop trkseg)

     

       494
       602
        
           | `El_end ->

     

       495
       603
        
             parser.current_element <- List.tl parser.current_element;

     

       496
       496
       -
             Ok { trkseg with trkpts = List.rev trkseg.trkpts }

     

       604
       604
       +
             Ok trkseg

     

       497
       605
        
           | `Data _ ->

     

       498
       606
        
             loop trkseg

     

       499
       607
        
           | `Dtd _ ->

     
···

       502
       610
        
         loop trkseg

     

       503
       611
        
       

     

       504
       612
        
       (** Main parsing function *)

     

       505
       505
       -
       let parse input =

     

       613
       613
       +
       let parse ?(validate=false) input =

     

       506
       614
        
         let parser = make_parser input in

     

       507
       615
        
         try

     

       508
       508
       -
           parse_gpx parser

     

       616
       616
       +
           let result = parse_gpx parser in

     

       617
       617
       +
           match result, validate with

     

       618
       618
       +
           | Ok gpx, true ->

     

       619
       619
       +
             let validation = Validate.validate_gpx gpx in

     

       620
       620
       +
             if validation.is_valid then

     

       621
       621
       +
               Ok gpx

     

       622
       622
       +
             else

     

       623
       623
       +
               let error_msgs = List.filter (fun issue -> issue.Validate.level = `Error) validation.issues

     

       624
       624
       +
                               |> List.map (fun issue -> issue.Validate.message)

     

       625
       625
       +
                               |> String.concat "; " in

     

       626
       626
       +
               Error (Error.validation_error error_msgs)

     

       627
       627
       +
           | result, false -> result

     

       628
       628
       +
           | Error _ as result, true -> result (* Pass through parse errors even when validating *)

     

       509
       629
        
         with

     

       510
       630
        
         | Xmlm.Error ((line, col), error) ->

     

       511
       511
       -
           Error (Xml_error (Printf.sprintf "XML error at line %d, column %d: %s"

     

       512
       512
       -
                             line col (Xmlm.error_message error)))

     

       631
       631
       +
           Error (Error.xml_error (Printf.sprintf "XML error at line %d, column %d: %s"

     

       632
       632
       +
                            line col (Xmlm.error_message error)))

     

       513
       633
        
         | exn ->

     

       514
       514
       -
           Error (Invalid_xml (Printexc.to_string exn))

     

       634
       634
       +
           Error (Error.invalid_xml (Printexc.to_string exn))

     

       515
       635
        
       

     

       516
       636
        
       (** Parse from string *)

     

       517
       517
       -
       let parse_string s =

     

       637
       637
       +
       let parse_string ?(validate=false) s =

     

       518
       638
        
         let input = Xmlm.make_input (`String (0, s)) in

     

       519
       519
       -
         parse input

     

       639
       639
       +
         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 : Xmlm.input -> gpx result

     

       4
       4
       +
       val parse : ?validate:bool -> Xmlm.input -> (Doc.t, Error.t) result

     

       7
       5
        
       

     

       8
       6
        
       (** Parse a GPX document from a string *)

     

       9
       9
       -
       val parse_string : string -> gpx result
     

       7
       7
       +
       val parse_string : ?validate:bool -> string -> (Doc.t, Error.t) result

+166

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 -> invalid_arg 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 name t = t.name

     

       43
       43
       +
       

     

       44
       44
       +
       (** Get route description *)

     

       45
       45
       +
       let description t = t.desc

     

       46
       46
       +
       

     

       47
       47
       +
       (** Get route number *)

     

       48
       48
       +
       let number t = t.number

     

       49
       49
       +
       

     

       50
       50
       +
       (** Get route comment *)

     

       51
       51
       +
       let comment t = t.cmt

     

       52
       52
       +
       

     

       53
       53
       +
       (** Get route source *)

     

       54
       54
       +
       let source t = t.src

     

       55
       55
       +
       

     

       56
       56
       +
       (** Get route links *)

     

       57
       57
       +
       let links t = t.links

     

       58
       58
       +
       

     

       59
       59
       +
       (** Get route type *)

     

       60
       60
       +
       let type_ t = t.type_

     

       61
       61
       +
       

     

       62
       62
       +
       (** Get route extensions *)

     

       63
       63
       +
       let extensions t = t.extensions

     

       64
       64
       +
       

     

       65
       65
       +
       (** Get route points *)

     

       66
       66
       +
       let points t = t.rtepts

     

       67
       67
       +
       

     

       68
       68
       +
       (** Get route point count *)

     

       69
       69
       +
       let point_count t = List.length t.rtepts

     

       70
       70
       +
       

     

       71
       71
       +
       

     

       72
       72
       +
       (** Clear all points *)

     

       73
       73
       +
       let clear_points t = { t with rtepts = [] }

     

       74
       74
       +
       

     

       75
       75
       +
       (** Extract coordinates from route *)

     

       76
       76
       +
       let to_coords t = List.map Waypoint.to_floats t.rtepts

     

       77
       77
       +
       

     

       78
       78
       +
       (** Simple great circle distance calculation *)

     

       79
       79
       +
       let great_circle_distance lat1 lon1 lat2 lon2 =

     

       80
       80
       +
         let deg_to_rad x = x *. Float.pi /. 180.0 in

     

       81
       81
       +
         let lat1_rad = deg_to_rad lat1 in

     

       82
       82
       +
         let lon1_rad = deg_to_rad lon1 in

     

       83
       83
       +
         let lat2_rad = deg_to_rad lat2 in

     

       84
       84
       +
         let lon2_rad = deg_to_rad lon2 in

     

       85
       85
       +
         let dlat = lat2_rad -. lat1_rad in

     

       86
       86
       +
         let dlon = lon2_rad -. lon1_rad in

     

       87
       87
       +
         let a = 

     

       88
       88
       +
           sin (dlat /. 2.0) ** 2.0 +. 

     

       89
       89
       +
           cos lat1_rad *. cos lat2_rad *. sin (dlon /. 2.0) ** 2.0 

     

       90
       90
       +
         in

     

       91
       91
       +
         let c = 2.0 *. asin (sqrt a) in

     

       92
       92
       +
         6371000.0 *. c (* Earth radius in meters *)

     

       93
       93
       +
       

     

       94
       94
       +
       (** Calculate total distance between consecutive points (naive great circle) *)

     

       95
       95
       +
       let total_distance t =

     

       96
       96
       +
         let rec calculate_distance acc = function

     

       97
       97
       +
           | [] | [_] -> acc

     

       98
       98
       +
           | p1 :: p2 :: rest ->

     

       99
       99
       +
             let lat1, lon1 = Waypoint.to_floats p1 in

     

       100
       100
       +
             let lat2, lon2 = Waypoint.to_floats p2 in

     

       101
       101
       +
             let distance = great_circle_distance lat1 lon1 lat2 lon2 in

     

       102
       102
       +
             calculate_distance (acc +. distance) (p2 :: rest)

     

       103
       103
       +
         in

     

       104
       104
       +
         calculate_distance 0.0 t.rtepts

     

       105
       105
       +
       

     

       106
       106
       +
       (** Check if route is empty *)

     

       107
       107
       +
       let is_empty t = List.length t.rtepts = 0

     

       108
       108
       +
       

     

       109
       109
       +
       (** Get first point *)

     

       110
       110
       +
       let first_point t = 

     

       111
       111
       +
         match t.rtepts with

     

       112
       112
       +
         | [] -> None

     

       113
       113
       +
         | p :: _ -> Some p

     

       114
       114
       +
       

     

       115
       115
       +
       (** Get last point *)

     

       116
       116
       +
       let last_point t =

     

       117
       117
       +
         match List.rev t.rtepts with

     

       118
       118
       +
         | [] -> None

     

       119
       119
       +
         | p :: _ -> Some p

     

       120
       120
       +
       

     

       121
       121
       +
       (** {2 Functional Operations} *)

     

       122
       122
       +
       

     

       123
       123
       +
       (** Update name *)

     

       124
       124
       +
       let with_name t name = { t with name = Some name }

     

       125
       125
       +
       

     

       126
       126
       +
       (** Update comment *)

     

       127
       127
       +
       let with_comment t cmt = { t with cmt = Some cmt }

     

       128
       128
       +
       

     

       129
       129
       +
       (** Update description *)

     

       130
       130
       +
       let with_description t desc = { t with desc = Some desc }

     

       131
       131
       +
       

     

       132
       132
       +
       (** Update source *)

     

       133
       133
       +
       let with_source t src = { t with src = Some src }

     

       134
       134
       +
       

     

       135
       135
       +
       (** Update number *)

     

       136
       136
       +
       let with_number t number = { t with number = Some number }

     

       137
       137
       +
       

     

       138
       138
       +
       (** Update type *)

     

       139
       139
       +
       let with_type t type_ = { t with type_ = Some type_ }

     

       140
       140
       +
       

     

       141
       141
       +
       (** Add point *)

     

       142
       142
       +
       let add_point t rtept = { t with rtepts = t.rtepts @ [rtept] }

     

       143
       143
       +
       

     

       144
       144
       +
       (** Add link *)

     

       145
       145
       +
       let add_link t link = { t with links = t.links @ [link] }

     

       146
       146
       +
       

     

       147
       147
       +
       (** Add extensions *)

     

       148
       148
       +
       let add_extensions t extensions = { t with extensions = t.extensions @ extensions }

     

       149
       149
       +
       

     

       150
       150
       +
       (** Compare routes *)

     

       151
       151
       +
       let compare t1 t2 =

     

       152
       152
       +
         let name_cmp = Option.compare String.compare t1.name t2.name in

     

       153
       153
       +
         if name_cmp <> 0 then name_cmp

     

       154
       154
       +
         else

     

       155
       155
       +
           let desc_cmp = Option.compare String.compare t1.desc t2.desc in

     

       156
       156
       +
           if desc_cmp <> 0 then desc_cmp

     

       157
       157
       +
           else List.compare Waypoint.compare t1.rtepts t2.rtepts

     

       158
       158
       +
       

     

       159
       159
       +
       (** Test route equality *)

     

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

     

       161
       161
       +
       

     

       162
       162
       +
       (** Pretty print route *)

     

       163
       163
       +
       let pp ppf t =

     

       164
       164
       +
         match t.name with

     

       165
       165
       +
         | Some name -> Format.fprintf ppf "\"%s\" (%d points)" name (point_count t)

     

       166
       166
       +
         | None -> Format.fprintf ppf "(unnamed route, %d points)" (point_count t)

+125

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 Invalid_argument 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 name : t -> string option

     

       37
       37
       +
       

     

       38
       38
       +
       (** Get route description *)

     

       39
       39
       +
       val description : t -> string option

     

       40
       40
       +
       

     

       41
       41
       +
       (** Get route number *)

     

       42
       42
       +
       val number : t -> int option

     

       43
       43
       +
       

     

       44
       44
       +
       (** Get route comment *)

     

       45
       45
       +
       val comment : t -> string option

     

       46
       46
       +
       

     

       47
       47
       +
       (** Get route source *)

     

       48
       48
       +
       val source : t -> string option

     

       49
       49
       +
       

     

       50
       50
       +
       (** Get route links *)

     

       51
       51
       +
       val links : t -> Link.t list

     

       52
       52
       +
       

     

       53
       53
       +
       (** Get route type *)

     

       54
       54
       +
       val type_ : t -> string option

     

       55
       55
       +
       

     

       56
       56
       +
       (** Get route extensions *)

     

       57
       57
       +
       val extensions : t -> Extension.t list

     

       58
       58
       +
       

     

       59
       59
       +
       (** Get route points *)

     

       60
       60
       +
       val points : t -> point list

     

       61
       61
       +
       

     

       62
       62
       +
       (** Get route point count *)

     

       63
       63
       +
       val point_count : t -> int

     

       64
       64
       +
       

     

       65
       65
       +
       (** Check if route is empty *)

     

       66
       66
       +
       val is_empty : t -> bool

     

       67
       67
       +
       

     

       68
       68
       +
       (** {2 Route Modification} *)

     

       69
       69
       +
       

     

       70
       70
       +
       (** Clear all points *)

     

       71
       71
       +
       val clear_points : t -> t

     

       72
       72
       +
       

     

       73
       73
       +
       (** {2 Route Analysis} *)

     

       74
       74
       +
       

     

       75
       75
       +
       (** Extract coordinates from route *)

     

       76
       76
       +
       val to_coords : t -> (float * float) list

     

       77
       77
       +
       

     

       78
       78
       +
       (** Calculate total distance between consecutive points in meters *)

     

       79
       79
       +
       val total_distance : t -> float

     

       80
       80
       +
       

     

       81
       81
       +
       (** Get first point *)

     

       82
       82
       +
       val first_point : t -> point option

     

       83
       83
       +
       

     

       84
       84
       +
       (** Get last point *)

     

       85
       85
       +
       val last_point : t -> point option

     

       86
       86
       +
       

     

       87
       87
       +
       (** {2 Functional Operations} *)

     

       88
       88
       +
       

     

       89
       89
       +
       (** Update name *)

     

       90
       90
       +
       val with_name : t -> string -> t

     

       91
       91
       +
       

     

       92
       92
       +
       (** Update comment *)

     

       93
       93
       +
       val with_comment : t -> string -> t

     

       94
       94
       +
       

     

       95
       95
       +
       (** Update description *)

     

       96
       96
       +
       val with_description : t -> string -> t

     

       97
       97
       +
       

     

       98
       98
       +
       (** Update source *)

     

       99
       99
       +
       val with_source : t -> string -> t

     

       100
       100
       +
       

     

       101
       101
       +
       (** Update number *)

     

       102
       102
       +
       val with_number : t -> int -> t

     

       103
       103
       +
       

     

       104
       104
       +
       (** Update type *)

     

       105
       105
       +
       val with_type : t -> string -> t

     

       106
       106
       +
       

     

       107
       107
       +
       (** Add point *)

     

       108
       108
       +
       val add_point : t -> point -> t

     

       109
       109
       +
       

     

       110
       110
       +
       (** Add link *)

     

       111
       111
       +
       val add_link : t -> Link.t -> t

     

       112
       112
       +
       

     

       113
       113
       +
       (** Add extensions *)

     

       114
       114
       +
       val add_extensions : t -> Extension.t list -> t

     

       115
       115
       +
       

     

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

     

       117
       117
       +
       

     

       118
       118
       +
       (** Compare routes *)

     

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

     

       120
       120
       +
       

     

       121
       121
       +
       (** Test route equality *)

     

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

     

       123
       123
       +
       

     

       124
       124
       +
       (** Pretty print route *)

     

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

+226

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 -> invalid_arg 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 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
       +
         (** Get extensions *)

     

       53
       53
       +
         let extensions (seg : segment) = seg.extensions

     

       54
       54
       +
       

     

       55
       55
       +
         (** Add point *)

     

       56
       56
       +
         let add_point t point = { t with trkpts = t.trkpts @ [point] }

     

       57
       57
       +
       

     

       58
       58
       +
         (** Add points *)

     

       59
       59
       +
         let add_points t points = { t with trkpts = t.trkpts @ points }

     

       60
       60
       +
       

     

       61
       61
       +
         (** Extract coordinates *)

     

       62
       62
       +
         let to_coords t = List.map Waypoint.to_floats t.trkpts

     

       63
       63
       +
       

     

       64
       64
       +
         (** Calculate segment distance *)

     

       65
       65
       +
         let distance t = Route.total_distance { Route.empty with rtepts = t.trkpts }

     

       66
       66
       +
       

     

       67
       67
       +
         (** Check if empty *)

     

       68
       68
       +
         let is_empty t = List.length t.trkpts = 0

     

       69
       69
       +
       

     

       70
       70
       +
         (** First point *)

     

       71
       71
       +
         let first_point t = 

     

       72
       72
       +
           match t.trkpts with

     

       73
       73
       +
           | [] -> None

     

       74
       74
       +
           | p :: _ -> Some p

     

       75
       75
       +
       

     

       76
       76
       +
         (** Last point *)

     

       77
       77
       +
         let last_point t =

     

       78
       78
       +
           match List.rev t.trkpts with

     

       79
       79
       +
           | [] -> None

     

       80
       80
       +
           | p :: _ -> Some p

     

       81
       81
       +
       

     

       82
       82
       +
         (** Compare segments *)

     

       83
       83
       +
         let compare t1 t2 = List.compare Waypoint.compare t1.trkpts t2.trkpts

     

       84
       84
       +
       

     

       85
       85
       +
         (** Test segment equality *)

     

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

     

       87
       87
       +
       

     

       88
       88
       +
         (** Pretty print segment *)

     

       89
       89
       +
         let pp ppf t = Format.fprintf ppf "segment (%d points)" (point_count t)

     

       90
       90
       +
       end

     

       91
       91
       +
       

     

       92
       92
       +
       (** {2 Track Operations} *)

     

       93
       93
       +
       

     

       94
       94
       +
       (** Create empty track *)

     

       95
       95
       +
       let empty = {

     

       96
       96
       +
         name = None; cmt = None; desc = None; src = None;

     

       97
       97
       +
         links = []; number = None; type_ = None; extensions = [];

     

       98
       98
       +
         trksegs = [];

     

       99
       99
       +
       }

     

       100
       100
       +
       

     

       101
       101
       +
       (** Create track with name *)

     

       102
       102
       +
       let make ~name = { empty with name = Some name }

     

       103
       103
       +
       

     

       104
       104
       +
       (** Create track from coordinate list (single segment) *)

     

       105
       105
       +
       let make_from_coords ~name coords =

     

       106
       106
       +
         let segment = Segment.make_from_coords coords in

     

       107
       107
       +
         { empty with name = Some name; trksegs = [segment] }

     

       108
       108
       +
       

     

       109
       109
       +
       (** Get track name *)

     

       110
       110
       +
       let name t = t.name

     

       111
       111
       +
       

     

       112
       112
       +
       (** Get track description *)

     

       113
       113
       +
       let description t = t.desc

     

       114
       114
       +
       

     

       115
       115
       +
       (** Get track comment *)

     

       116
       116
       +
       let comment t = t.cmt

     

       117
       117
       +
       

     

       118
       118
       +
       (** Get track source *)

     

       119
       119
       +
       let source t = t.src

     

       120
       120
       +
       

     

       121
       121
       +
       (** Get track links *)

     

       122
       122
       +
       let links t = t.links

     

       123
       123
       +
       

     

       124
       124
       +
       (** Get track number *)

     

       125
       125
       +
       let number t = t.number

     

       126
       126
       +
       

     

       127
       127
       +
       (** Get track type *)

     

       128
       128
       +
       let type_ t = t.type_

     

       129
       129
       +
       

     

       130
       130
       +
       (** Get track extensions *)

     

       131
       131
       +
       let extensions t = t.extensions

     

       132
       132
       +
       

     

       133
       133
       +
       (** Get track segments *)

     

       134
       134
       +
       let segments t = t.trksegs

     

       135
       135
       +
       

     

       136
       136
       +
       (** Get segment count *)

     

       137
       137
       +
       let segment_count t = List.length t.trksegs

     

       138
       138
       +
       

     

       139
       139
       +
       (** Get total point count across all segments *)

     

       140
       140
       +
       let point_count t = 

     

       141
       141
       +
         List.fold_left (fun acc seg -> acc + Segment.point_count seg) 0 t.trksegs

     

       142
       142
       +
       

     

       143
       143
       +
       

     

       144
       144
       +
       (** Clear all segments *)

     

       145
       145
       +
       let clear_segments t = { t with trksegs = [] }

     

       146
       146
       +
       

     

       147
       147
       +
       (** Extract all coordinates from track *)

     

       148
       148
       +
       let to_coords t =

     

       149
       149
       +
         List.fold_left (fun acc seg ->

     

       150
       150
       +
           List.fold_left (fun acc trkpt ->

     

       151
       151
       +
             Waypoint.to_floats trkpt :: acc

     

       152
       152
       +
           ) acc seg.trkpts

     

       153
       153
       +
         ) [] t.trksegs

     

       154
       154
       +
         |> List.rev

     

       155
       155
       +
       

     

       156
       156
       +
       (** Calculate total track distance across all segments *)

     

       157
       157
       +
       let total_distance t =

     

       158
       158
       +
         List.fold_left (fun acc seg -> acc +. Segment.distance seg) 0.0 t.trksegs

     

       159
       159
       +
       

     

       160
       160
       +
       (** Check if track is empty *)

     

       161
       161
       +
       let is_empty t = List.length t.trksegs = 0

     

       162
       162
       +
       

     

       163
       163
       +
       (** Get all points from all segments *)

     

       164
       164
       +
       let all_points t =

     

       165
       165
       +
         List.fold_left (fun acc seg -> acc @ seg.trkpts) [] t.trksegs

     

       166
       166
       +
       

     

       167
       167
       +
       (** Get first point from first segment *)

     

       168
       168
       +
       let first_point t =

     

       169
       169
       +
         match t.trksegs with

     

       170
       170
       +
         | [] -> None

     

       171
       171
       +
         | seg :: _ -> Segment.first_point seg

     

       172
       172
       +
       

     

       173
       173
       +
       (** Get last point from last segment *)

     

       174
       174
       +
       let last_point t =

     

       175
       175
       +
         match List.rev t.trksegs with

     

       176
       176
       +
         | [] -> None

     

       177
       177
       +
         | seg :: _ -> Segment.last_point seg

     

       178
       178
       +
       

     

       179
       179
       +
       (** Compare tracks *)

     

       180
       180
       +
       let compare t1 t2 =

     

       181
       181
       +
         let name_cmp = Option.compare String.compare t1.name t2.name in

     

       182
       182
       +
         if name_cmp <> 0 then name_cmp

     

       183
       183
       +
         else

     

       184
       184
       +
           let desc_cmp = Option.compare String.compare t1.desc t2.desc in

     

       185
       185
       +
           if desc_cmp <> 0 then desc_cmp

     

       186
       186
       +
           else List.compare Segment.compare t1.trksegs t2.trksegs

     

       187
       187
       +
       

     

       188
       188
       +
       (** Test track equality *)

     

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

     

       190
       190
       +
       

     

       191
       191
       +
       (** {2 Functional Operations} *)

     

       192
       192
       +
       

     

       193
       193
       +
       (** Update name *)

     

       194
       194
       +
       let with_name t name = { t with name = Some name }

     

       195
       195
       +
       

     

       196
       196
       +
       (** Update comment *)

     

       197
       197
       +
       let with_comment t cmt = { t with cmt = Some cmt }

     

       198
       198
       +
       

     

       199
       199
       +
       (** Update description *)

     

       200
       200
       +
       let with_description t desc = { t with desc = Some desc }

     

       201
       201
       +
       

     

       202
       202
       +
       (** Update source *)

     

       203
       203
       +
       let with_source t src = { t with src = Some src }

     

       204
       204
       +
       

     

       205
       205
       +
       (** Update number *)

     

       206
       206
       +
       let with_number t number = { t with number = Some number }

     

       207
       207
       +
       

     

       208
       208
       +
       (** Update type *)

     

       209
       209
       +
       let with_type t type_ = { t with type_ = Some type_ }

     

       210
       210
       +
       

     

       211
       211
       +
       (** Add segment *)

     

       212
       212
       +
       let add_segment t trkseg = { t with trksegs = t.trksegs @ [trkseg] }

     

       213
       213
       +
       

     

       214
       214
       +
       (** Add link *)

     

       215
       215
       +
       let add_link t link = { t with links = t.links @ [link] }

     

       216
       216
       +
       

     

       217
       217
       +
       (** Add extensions *)

     

       218
       218
       +
       let add_extensions t extensions = { t with extensions = t.extensions @ extensions }

     

       219
       219
       +
       

     

       220
       220
       +
       (** Pretty print track *)

     

       221
       221
       +
       let pp ppf t =

     

       222
       222
       +
         match t.name with

     

       223
       223
       +
         | Some name -> Format.fprintf ppf "\"%s\" (%d segments, %d points)" 

     

       224
       224
       +
                          name (segment_count t) (point_count t)

     

       225
       225
       +
         | None -> Format.fprintf ppf "(unnamed track, %d segments, %d points)" 

     

       226
       226
       +
                     (segment_count t) (point_count t)

+192

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 Invalid_argument on invalid coordinates *)

     

       38
       38
       +
         val make_from_coords : (float * float) list -> t

     

       39
       39
       +
       

     

       40
       40
       +
         (** Get points *)

     

       41
       41
       +
         val points : t -> point list

     

       42
       42
       +
       

     

       43
       43
       +
         (** Get point count *)

     

       44
       44
       +
         val point_count : t -> int

     

       45
       45
       +
       

     

       46
       46
       +
         (** Get extensions *)

     

       47
       47
       +
         val extensions : t -> Extension.t list

     

       48
       48
       +
       

     

       49
       49
       +
         (** Add point *)

     

       50
       50
       +
         val add_point : t -> point -> t

     

       51
       51
       +
       

     

       52
       52
       +
         (** Add points *)

     

       53
       53
       +
         val add_points : t -> point list -> t

     

       54
       54
       +
       

     

       55
       55
       +
         (** Extract coordinates *)

     

       56
       56
       +
         val to_coords : t -> (float * float) list

     

       57
       57
       +
       

     

       58
       58
       +
         (** Calculate segment distance in meters *)

     

       59
       59
       +
         val distance : t -> float

     

       60
       60
       +
       

     

       61
       61
       +
         (** Check if empty *)

     

       62
       62
       +
         val is_empty : t -> bool

     

       63
       63
       +
       

     

       64
       64
       +
         (** First point *)

     

       65
       65
       +
         val first_point : t -> point option

     

       66
       66
       +
       

     

       67
       67
       +
         (** Last point *)

     

       68
       68
       +
         val last_point : t -> point option

     

       69
       69
       +
       

     

       70
       70
       +
         (** Compare segments *)

     

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

     

       72
       72
       +
       

     

       73
       73
       +
         (** Test segment equality *)

     

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

     

       75
       75
       +
       

     

       76
       76
       +
         (** Pretty print segment *)

     

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

     

       78
       78
       +
       end

     

       79
       79
       +
       

     

       80
       80
       +
       (** {2 Track Constructors} *)

     

       81
       81
       +
       

     

       82
       82
       +
       (** Create empty track *)

     

       83
       83
       +
       val empty : t

     

       84
       84
       +
       

     

       85
       85
       +
       (** Create track with name *)

     

       86
       86
       +
       val make : name:string -> t

     

       87
       87
       +
       

     

       88
       88
       +
       (** Create track from coordinate list (single segment).

     

       89
       89
       +
           @param name Track name

     

       90
       90
       +
           @param coords List of (latitude, longitude) pairs

     

       91
       91
       +
           @raises Failure on invalid coordinates *)

     

       92
       92
       +
       val make_from_coords : name:string -> (float * float) list -> t

     

       93
       93
       +
       

     

       94
       94
       +
       (** {2 Track Properties} *)

     

       95
       95
       +
       

     

       96
       96
       +
       (** Get track name *)

     

       97
       97
       +
       val name : t -> string option

     

       98
       98
       +
       

     

       99
       99
       +
       (** Get track description *)

     

       100
       100
       +
       val description : t -> string option

     

       101
       101
       +
       

     

       102
       102
       +
       (** Get track comment *)

     

       103
       103
       +
       val comment : t -> string option

     

       104
       104
       +
       

     

       105
       105
       +
       (** Get track source *)

     

       106
       106
       +
       val source : t -> string option

     

       107
       107
       +
       

     

       108
       108
       +
       (** Get track links *)

     

       109
       109
       +
       val links : t -> Link.t list

     

       110
       110
       +
       

     

       111
       111
       +
       (** Get track number *)

     

       112
       112
       +
       val number : t -> int option

     

       113
       113
       +
       

     

       114
       114
       +
       (** Get track type *)

     

       115
       115
       +
       val type_ : t -> string option

     

       116
       116
       +
       

     

       117
       117
       +
       (** Get track extensions *)

     

       118
       118
       +
       val extensions : t -> Extension.t list

     

       119
       119
       +
       

     

       120
       120
       +
       (** Get track segments *)

     

       121
       121
       +
       val segments : t -> segment list

     

       122
       122
       +
       

     

       123
       123
       +
       (** Get segment count *)

     

       124
       124
       +
       val segment_count : t -> int

     

       125
       125
       +
       

     

       126
       126
       +
       (** Get total point count across all segments *)

     

       127
       127
       +
       val point_count : t -> int

     

       128
       128
       +
       

     

       129
       129
       +
       (** Check if track is empty *)

     

       130
       130
       +
       val is_empty : t -> bool

     

       131
       131
       +
       

     

       132
       132
       +
       (** {2 Track Modification} *)

     

       133
       133
       +
       

     

       134
       134
       +
       (** Clear all segments *)

     

       135
       135
       +
       val clear_segments : t -> t

     

       136
       136
       +
       

     

       137
       137
       +
       (** {2 Track Analysis} *)

     

       138
       138
       +
       

     

       139
       139
       +
       (** Extract all coordinates from track *)

     

       140
       140
       +
       val to_coords : t -> (float * float) list

     

       141
       141
       +
       

     

       142
       142
       +
       (** Calculate total track distance across all segments in meters *)

     

       143
       143
       +
       val total_distance : t -> float

     

       144
       144
       +
       

     

       145
       145
       +
       (** Get all points from all segments *)

     

       146
       146
       +
       val all_points : t -> point list

     

       147
       147
       +
       

     

       148
       148
       +
       (** Get first point from first segment *)

     

       149
       149
       +
       val first_point : t -> point option

     

       150
       150
       +
       

     

       151
       151
       +
       (** Get last point from last segment *)

     

       152
       152
       +
       val last_point : t -> point option

     

       153
       153
       +
       

     

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

     

       155
       155
       +
       

     

       156
       156
       +
       (** Compare tracks *)

     

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

     

       158
       158
       +
       

     

       159
       159
       +
       (** Test track equality *)

     

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

     

       161
       161
       +
       

     

       162
       162
       +
       (** {2 Functional Operations} *)

     

       163
       163
       +
       

     

       164
       164
       +
       (** Update name *)

     

       165
       165
       +
       val with_name : t -> string -> t

     

       166
       166
       +
       

     

       167
       167
       +
       (** Update comment *)

     

       168
       168
       +
       val with_comment : t -> string -> t

     

       169
       169
       +
       

     

       170
       170
       +
       (** Update description *)

     

       171
       171
       +
       val with_description : t -> string -> t

     

       172
       172
       +
       

     

       173
       173
       +
       (** Update source *)

     

       174
       174
       +
       val with_source : t -> string -> t

     

       175
       175
       +
       

     

       176
       176
       +
       (** Update number *)

     

       177
       177
       +
       val with_number : t -> int -> t

     

       178
       178
       +
       

     

       179
       179
       +
       (** Update type *)

     

       180
       180
       +
       val with_type : t -> string -> t

     

       181
       181
       +
       

     

       182
       182
       +
       (** Add segment *)

     

       183
       183
       +
       val add_segment : t -> Segment.t -> t

     

       184
       184
       +
       

     

       185
       185
       +
       (** Add link *)

     

       186
       186
       +
       val add_link : t -> Link.t -> t

     

       187
       187
       +
       

     

       188
       188
       +
       (** Add extensions *)

     

       189
       189
       +
       val add_extensions : t -> Extension.t list -> t

     

       190
       190
       +
       

     

       191
       191
       +
       (** Pretty print track *)

     

       192
       192
       +
       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

+40 -33

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.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.hdop wpt);

     

       48
       48
       +
         check_precision "vdop" (Waypoint.vdop wpt);

     

       49
       49
       +
         check_precision "pdop" (Waypoint.pdop wpt);

     

       52
       50
        
         

     

       53
       51
        
         (* Check elevation reasonableness *)

     

       54
       54
       -
         (match wpt.ele with

     

       52
       52
       +
         (match Waypoint.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.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.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.bounds_opt 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.copyright metadata with

     

       93
       92
        
          | Some copyright ->

     

       94
       94
       -
            (match copyright.year with

     

       93
       93
       +
            (match Link.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.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.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.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.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.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 = Doc.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 = Doc.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 Doc.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 = Doc.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 = Doc.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 = Doc.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

     
···

       214
       221
        
         result.is_valid

     

       215
       222
        
       

     

       216
       223
        
       (** Get only error messages *)

     

       217
       217
       -
       let get_errors gpx =

     

       224
       224
       +
       let errors gpx =

     

       218
       225
        
         let result = validate_gpx gpx in

     

       219
       226
        
         List.filter (fun issue -> issue.level = `Error) result.issues

     

       220
       227
        
       

     

       221
       228
        
       (** Get only warning messages *)

     

       222
       222
       -
       let get_warnings gpx =

     

       229
       229
       +
       let warnings gpx =

     

       223
       230
        
         let result = validate_gpx gpx in

     

       224
       231
        
         List.filter (fun issue -> issue.level = `Warning) result.issues

     

       225
       232

+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 : 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 : Doc.t -> bool

     

       23
       21
        
       

     

       24
       22
        
       (** Get only error messages *)

     

       25
       25
       -
       val get_errors : gpx -> validation_issue list

     

       23
       23
       +
       val errors : 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 warnings : Doc.t -> validation_issue list

     

       29
       27
        
       

     

       30
       28
        
       (** Format validation issue for display *)

     

       31
       29
        
       val format_issue : validation_issue -> string

+246

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 coordinate t = Coordinate.make t.lat t.lon

     

       90
       90
       +
       

     

       91
       91
       +
       (** Get latitude *)

     

       92
       92
       +
       let lat t = t.lat

     

       93
       93
       +
       

     

       94
       94
       +
       (** Get longitude *)

     

       95
       95
       +
       let 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 elevation t = t.ele

     

       102
       102
       +
       

     

       103
       103
       +
       (** Get time *)

     

       104
       104
       +
       let time t = t.time

     

       105
       105
       +
       

     

       106
       106
       +
       (** Get name *)

     

       107
       107
       +
       let name t = t.name

     

       108
       108
       +
       

     

       109
       109
       +
       (** Get description *)

     

       110
       110
       +
       let description t = t.desc

     

       111
       111
       +
       

     

       112
       112
       +
       (** Get comment *)

     

       113
       113
       +
       let comment t = t.cmt

     

       114
       114
       +
       

     

       115
       115
       +
       (** Get source *)

     

       116
       116
       +
       let source t = t.src

     

       117
       117
       +
       

     

       118
       118
       +
       (** Get symbol *)

     

       119
       119
       +
       let symbol t = t.sym

     

       120
       120
       +
       

     

       121
       121
       +
       (** Get type *)

     

       122
       122
       +
       let type_ t = t.type_

     

       123
       123
       +
       

     

       124
       124
       +
       (** Get fix type *)

     

       125
       125
       +
       let fix t = t.fix

     

       126
       126
       +
       

     

       127
       127
       +
       (** Get satellite count *)

     

       128
       128
       +
       let sat t = t.sat

     

       129
       129
       +
       

     

       130
       130
       +
       (** Get horizontal dilution of precision *)

     

       131
       131
       +
       let hdop t = t.hdop

     

       132
       132
       +
       

     

       133
       133
       +
       (** Get vertical dilution of precision *)

     

       134
       134
       +
       let vdop t = t.vdop

     

       135
       135
       +
       

     

       136
       136
       +
       (** Get position dilution of precision *)

     

       137
       137
       +
       let pdop t = t.pdop

     

       138
       138
       +
       

     

       139
       139
       +
       (** Get magnetic variation *)

     

       140
       140
       +
       let magvar t = t.magvar

     

       141
       141
       +
       

     

       142
       142
       +
       (** Get geoid height *)

     

       143
       143
       +
       let geoidheight t = t.geoidheight

     

       144
       144
       +
       

     

       145
       145
       +
       (** Get age of DGPS data *)

     

       146
       146
       +
       let ageofdgpsdata t = t.ageofdgpsdata

     

       147
       147
       +
       

     

       148
       148
       +
       (** Get DGPS ID *)

     

       149
       149
       +
       let dgpsid t = t.dgpsid

     

       150
       150
       +
       

     

       151
       151
       +
       (** Get links *)

     

       152
       152
       +
       let links t = t.links

     

       153
       153
       +
       

     

       154
       154
       +
       (** Get extensions *)

     

       155
       155
       +
       let extensions t = t.extensions

     

       156
       156
       +
       

     

       157
       157
       +
       (** Update elevation *)

     

       158
       158
       +
       let with_elevation t ele = { t with ele = Some ele }

     

       159
       159
       +
       

     

       160
       160
       +
       (** Update time *)

     

       161
       161
       +
       let with_time t time = { t with time }

     

       162
       162
       +
       

     

       163
       163
       +
       (** Update name *)

     

       164
       164
       +
       let with_name t name = { t with name = Some name }

     

       165
       165
       +
       

     

       166
       166
       +
       (** Update comment *)

     

       167
       167
       +
       let with_comment t cmt = { t with cmt = Some cmt }

     

       168
       168
       +
       

     

       169
       169
       +
       (** Update description *)

     

       170
       170
       +
       let with_description t desc = { t with desc = Some desc }

     

       171
       171
       +
       

     

       172
       172
       +
       (** Update source *)

     

       173
       173
       +
       let with_source t src = { t with src = Some src }

     

       174
       174
       +
       

     

       175
       175
       +
       (** Update symbol *)

     

       176
       176
       +
       let with_symbol t sym = { t with sym = Some sym }

     

       177
       177
       +
       

     

       178
       178
       +
       (** Update type *)

     

       179
       179
       +
       let with_type t type_ = { t with type_ = Some type_ }

     

       180
       180
       +
       

     

       181
       181
       +
       (** Update fix *)

     

       182
       182
       +
       let with_fix t fix = { t with fix }

     

       183
       183
       +
       

     

       184
       184
       +
       (** Update satellite count *)

     

       185
       185
       +
       let with_sat t sat = { t with sat = Some sat }

     

       186
       186
       +
       

     

       187
       187
       +
       (** Update HDOP *)

     

       188
       188
       +
       let with_hdop t hdop = { t with hdop = Some hdop }

     

       189
       189
       +
       

     

       190
       190
       +
       (** Update VDOP *)

     

       191
       191
       +
       let with_vdop t vdop = { t with vdop = Some vdop }

     

       192
       192
       +
       

     

       193
       193
       +
       (** Update PDOP *)

     

       194
       194
       +
       let with_pdop t pdop = { t with pdop = Some pdop }

     

       195
       195
       +
       

     

       196
       196
       +
       (** Update magnetic variation *)

     

       197
       197
       +
       let with_magvar t magvar = { t with magvar = Some magvar }

     

       198
       198
       +
       

     

       199
       199
       +
       (** Update geoid height *)

     

       200
       200
       +
       let with_geoidheight t geoidheight = { t with geoidheight = Some geoidheight }

     

       201
       201
       +
       

     

       202
       202
       +
       (** Update age of DGPS data *)

     

       203
       203
       +
       let with_ageofdgpsdata t ageofdgpsdata = { t with ageofdgpsdata = Some ageofdgpsdata }

     

       204
       204
       +
       

     

       205
       205
       +
       (** Update DGPS ID *)

     

       206
       206
       +
       let with_dgpsid t dgpsid = { t with dgpsid = Some dgpsid }

     

       207
       207
       +
       

     

       208
       208
       +
       (** Add link *)

     

       209
       209
       +
       let add_link t link = { t with links = link :: t.links }

     

       210
       210
       +
       

     

       211
       211
       +
       (** Add extensions *)

     

       212
       212
       +
       let add_extensions t extensions = { t with extensions = extensions @ t.extensions }

     

       213
       213
       +
       

     

       214
       214
       +
       (** Compare waypoints *)

     

       215
       215
       +
       let compare t1 t2 =

     

       216
       216
       +
         let lat_cmp = Float.compare 

     

       217
       217
       +
           (Coordinate.latitude_to_float t1.lat) 

     

       218
       218
       +
           (Coordinate.latitude_to_float t2.lat) in

     

       219
       219
       +
         if lat_cmp <> 0 then lat_cmp

     

       220
       220
       +
         else

     

       221
       221
       +
           let lon_cmp = Float.compare 

     

       222
       222
       +
             (Coordinate.longitude_to_float t1.lon) 

     

       223
       223
       +
             (Coordinate.longitude_to_float t2.lon) in

     

       224
       224
       +
           if lon_cmp <> 0 then lon_cmp

     

       225
       225
       +
           else

     

       226
       226
       +
             let ele_cmp = Option.compare Float.compare t1.ele t2.ele in

     

       227
       227
       +
             if ele_cmp <> 0 then ele_cmp

     

       228
       228
       +
             else Option.compare Ptime.compare t1.time t2.time

     

       229
       229
       +
       

     

       230
       230
       +
       (** Test waypoint equality *)

     

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

     

       232
       232
       +
       

     

       233
       233
       +
       (** Pretty print waypoint *)

     

       234
       234
       +
       let pp ppf t =

     

       235
       235
       +
         let lat, lon = to_floats t in

     

       236
       236
       +
         match t.name with

     

       237
       237
       +
         | Some name -> Format.fprintf ppf "%s @ (%g, %g)" name lat lon

     

       238
       238
       +
         | None -> Format.fprintf ppf "(%g, %g)" lat lon

     

       239
       239
       +
       

     

       240
       240
       +
       (** Pretty print fix type *)

     

       241
       241
       +
       let pp_fix_type ppf = function

     

       242
       242
       +
         | None_fix -> Format.fprintf ppf "none"

     

       243
       243
       +
         | Fix_2d -> Format.fprintf ppf "2d"

     

       244
       244
       +
         | Fix_3d -> Format.fprintf ppf "3d" 

     

       245
       245
       +
         | Dgps -> Format.fprintf ppf "dgps"

     

       246
       246
       +
         | Pps -> Format.fprintf ppf "pps"

+193

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 coordinate : t -> Coordinate.t

     

       60
       60
       +
       

     

       61
       61
       +
       (** Get latitude *)

     

       62
       62
       +
       val lat : t -> Coordinate.latitude

     

       63
       63
       +
       

     

       64
       64
       +
       (** Get longitude *)

     

       65
       65
       +
       val 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 elevation : t -> float option

     

       72
       72
       +
       

     

       73
       73
       +
       (** Get time *)

     

       74
       74
       +
       val time : t -> Ptime.t option

     

       75
       75
       +
       

     

       76
       76
       +
       (** Get name *)

     

       77
       77
       +
       val name : t -> string option

     

       78
       78
       +
       

     

       79
       79
       +
       (** Get description *)

     

       80
       80
       +
       val description : t -> string option

     

       81
       81
       +
       

     

       82
       82
       +
       (** Get comment *)

     

       83
       83
       +
       val comment : t -> string option

     

       84
       84
       +
       

     

       85
       85
       +
       (** Get source *)

     

       86
       86
       +
       val source : t -> string option

     

       87
       87
       +
       

     

       88
       88
       +
       (** Get symbol *)

     

       89
       89
       +
       val symbol : t -> string option

     

       90
       90
       +
       

     

       91
       91
       +
       (** Get type *)

     

       92
       92
       +
       val type_ : t -> string option

     

       93
       93
       +
       

     

       94
       94
       +
       (** Get fix type *)

     

       95
       95
       +
       val fix : t -> fix_type option

     

       96
       96
       +
       

     

       97
       97
       +
       (** Get satellite count *)

     

       98
       98
       +
       val sat : t -> int option

     

       99
       99
       +
       

     

       100
       100
       +
       (** Get horizontal dilution of precision *)

     

       101
       101
       +
       val hdop : t -> float option

     

       102
       102
       +
       

     

       103
       103
       +
       (** Get vertical dilution of precision *)

     

       104
       104
       +
       val vdop : t -> float option

     

       105
       105
       +
       

     

       106
       106
       +
       (** Get position dilution of precision *)

     

       107
       107
       +
       val pdop : t -> float option

     

       108
       108
       +
       

     

       109
       109
       +
       (** Get magnetic variation *)

     

       110
       110
       +
       val magvar : t -> Coordinate.degrees option

     

       111
       111
       +
       

     

       112
       112
       +
       (** Get geoid height *)

     

       113
       113
       +
       val geoidheight : t -> float option

     

       114
       114
       +
       

     

       115
       115
       +
       (** Get age of DGPS data *)

     

       116
       116
       +
       val ageofdgpsdata : t -> float option

     

       117
       117
       +
       

     

       118
       118
       +
       (** Get DGPS ID *)

     

       119
       119
       +
       val dgpsid : t -> int option

     

       120
       120
       +
       

     

       121
       121
       +
       (** Get links *)

     

       122
       122
       +
       val links : t -> Link.t list

     

       123
       123
       +
       

     

       124
       124
       +
       (** Get extensions *)

     

       125
       125
       +
       val extensions : t -> Extension.t list

     

       126
       126
       +
       

     

       127
       127
       +
       (** Functional operations for building waypoints *)

     

       128
       128
       +
       

     

       129
       129
       +
       (** Update elevation *)

     

       130
       130
       +
       val with_elevation : t -> float -> t

     

       131
       131
       +
       

     

       132
       132
       +
       (** Update time *)

     

       133
       133
       +
       val with_time : t -> Ptime.t option -> t

     

       134
       134
       +
       

     

       135
       135
       +
       (** Update name *)

     

       136
       136
       +
       val with_name : t -> string -> t

     

       137
       137
       +
       

     

       138
       138
       +
       (** Update comment *)

     

       139
       139
       +
       val with_comment : t -> string -> t

     

       140
       140
       +
       

     

       141
       141
       +
       (** Update description *)

     

       142
       142
       +
       val with_description : t -> string -> t

     

       143
       143
       +
       

     

       144
       144
       +
       (** Update source *)

     

       145
       145
       +
       val with_source : t -> string -> t

     

       146
       146
       +
       

     

       147
       147
       +
       (** Update symbol *)

     

       148
       148
       +
       val with_symbol : t -> string -> t

     

       149
       149
       +
       

     

       150
       150
       +
       (** Update type *)

     

       151
       151
       +
       val with_type : t -> string -> t

     

       152
       152
       +
       

     

       153
       153
       +
       (** Update fix *)

     

       154
       154
       +
       val with_fix : t -> fix_type option -> t

     

       155
       155
       +
       

     

       156
       156
       +
       (** Update satellite count *)

     

       157
       157
       +
       val with_sat : t -> int -> t

     

       158
       158
       +
       

     

       159
       159
       +
       (** Update HDOP *)

     

       160
       160
       +
       val with_hdop : t -> float -> t

     

       161
       161
       +
       

     

       162
       162
       +
       (** Update VDOP *)

     

       163
       163
       +
       val with_vdop : t -> float -> t

     

       164
       164
       +
       

     

       165
       165
       +
       (** Update PDOP *)

     

       166
       166
       +
       val with_pdop : t -> float -> t

     

       167
       167
       +
       

     

       168
       168
       +
       (** Update magnetic variation *)

     

       169
       169
       +
       val with_magvar : t -> Coordinate.degrees -> t

     

       170
       170
       +
       

     

       171
       171
       +
       (** Update geoid height *)

     

       172
       172
       +
       val with_geoidheight : t -> float -> t

     

       173
       173
       +
       

     

       174
       174
       +
       (** Update age of DGPS data *)

     

       175
       175
       +
       val with_ageofdgpsdata : t -> float -> t

     

       176
       176
       +
       

     

       177
       177
       +
       (** Update DGPS ID *)

     

       178
       178
       +
       val with_dgpsid : t -> int -> t

     

       179
       179
       +
       

     

       180
       180
       +
       (** Add link *)

     

       181
       181
       +
       val add_link : t -> Link.t -> t

     

       182
       182
       +
       

     

       183
       183
       +
       (** Add extensions *)

     

       184
       184
       +
       val add_extensions : t -> Extension.t list -> t

     

       185
       185
       +
       

     

       186
       186
       +
       (** Compare waypoints *)

     

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

     

       188
       188
       +
       

     

       189
       189
       +
       (** Test waypoint equality *)

     

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

     

       191
       191
       +
       

     

       192
       192
       +
       (** Pretty print waypoint *)

     

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

+265 -294

lib/gpx/writer.ml

···

       1
       1
       -
       (** GPX streaming writer using xmlm *)

     

       2
       2
       -
       

     

       3
       3
       -
       open Types

     

       1
       1
       +
       (** GPX XML writer with complete spec coverage *)

     

       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
       38
        
       let output_optional_float_element writer name = function

     

       57
       57
       -
         | Some f -> output_float_element writer name f

     

       39
       39
       +
         | Some value -> output_text_element writer name (Printf.sprintf "%.6f" value)

     

       58
       40
        
         | None -> Ok ()

     

       59
       41
        
       

     

       60
       60
       -
       let output_int_element writer name i =

     

       61
       61
       -
         output_text_element writer name (string_of_int i)

     

       42
       42
       +
       let output_optional_degrees_element writer name = function

     

       43
       43
       +
         | Some degrees -> output_text_element writer name (Printf.sprintf "%.6f" (Coordinate.degrees_to_float degrees))

     

       44
       44
       +
         | None -> Ok ()

     

       62
       45
        
       

     

       63
       46
        
       let output_optional_int_element writer name = function

     

       64
       64
       -
         | Some i -> output_int_element writer name i

     

       47
       47
       +
         | Some value -> output_text_element writer name (string_of_int value)

     

       65
       48
        
         | None -> Ok ()

     

       66
       49
        
       

     

       67
       67
       -
       let output_time_element writer name time =

     

       68
       68
       -
         output_text_element writer name (Ptime.to_rfc3339 time)

     

       69
       69
       -
       

     

       70
       50
        
       let output_optional_time_element writer name = function

     

       71
       71
       -
         | Some time -> output_time_element writer name time

     

       51
       51
       +
         | Some time -> output_text_element writer name (Ptime.to_rfc3339 time)

     

       72
       52
        
         | None -> Ok ()

     

       73
       53
        
       

     

       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 ()

     

       54
       54
       +
       let output_optional_fix_element writer name = function

     

       55
       55
       +
         | Some fix_type -> output_text_element writer name (Waypoint.fix_type_to_string fix_type)

     

       56
       56
       +
         | None -> Ok ()

     

       78
       57
        
       

     

       79
       79
       -
       (** Write link element *)

     

       80
       80
       -
       let write_link writer link =

     

       81
       81
       -
         let attrs = [(("" , "href"), link.href)] in

     

       58
       58
       +
       (** Write link elements *)

     

       59
       59
       +
       let output_link writer link =

     

       60
       60
       +
         let href = Link.href link in

     

       61
       61
       +
         let attrs = [(("", "href"), href)] in

     

       82
       62
        
         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

     

       63
       63
       +
         let* () = output_optional_text_element writer "text" (Link.text link) in

     

       64
       64
       +
         let* () = output_optional_text_element writer "type" (Link.type_ link) in

     

       85
       65
        
         output_element_end writer

     

       86
       66
        
       

     

       87
       87
       -
       (** Write list of links *)

     

       88
       88
       -
       let write_links writer links =

     

       89
       89
       -
         let rec loop = function

     

       67
       67
       +
       let output_links writer links =

     

       68
       68
       +
         let rec write_links = function

     

       90
       69
        
           | [] -> Ok ()

     

       91
       70
        
           | link :: rest ->

     

       92
       92
       -
             let* () = write_link writer link in

     

       93
       93
       -
             loop rest

     

       71
       71
       +
               let* () = output_link writer link in

     

       72
       72
       +
               write_links rest

     

       94
       73
        
         in

     

       95
       95
       -
         loop links

     

       74
       74
       +
         write_links links

     

       96
       75
        
       

     

       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

     

       76
       76
       +
       (** Write person (author) element *)

     

       77
       77
       +
       let output_person writer person =

     

       78
       78
       +
         let* () = output_element_start writer "author" [] in

     

       79
       79
       +
         let* () = output_optional_text_element writer "name" (Link.person_name person) in

     

       80
       80
       +
         let* () = match Link.person_email person with

     

       81
       81
       +
           | Some email ->

     

       82
       82
       +
               (* Parse email into id and domain *)

     

       83
       83
       +
               (match String.index_opt email '@' with

     

       84
       84
       +
                | Some at_pos ->

     

       85
       85
       +
                    let id = String.sub email 0 at_pos in

     

       86
       86
       +
                    let domain = String.sub email (at_pos + 1) (String.length email - at_pos - 1) in

     

       87
       87
       +
                    let attrs = [(("", "id"), id); (("", "domain"), domain)] in

     

       88
       88
       +
                    let* () = output_element_start writer "email" attrs in

     

       89
       89
       +
                    output_element_end writer

     

       90
       90
       +
                | None ->

     

       91
       91
       +
                    (* Invalid email format, skip *)

     

       92
       92
       +
                    Ok ())

     

       93
       93
       +
           | None -> Ok ()

     

       112
       94
        
         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

     

       95
       95
       +
         let* () = match Link.person_link person with

     

       96
       96
       +
           | Some link -> output_link writer link

     

       97
       97
       +
           | None -> Ok ()

     

       119
       98
        
         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
       99
        
         output_element_end writer

     

       123
       100
        
       

     

       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

     

       101
       101
       +
       (** Write copyright element *)

     

       102
       102
       +
       let output_copyright writer copyright =

     

       103
       103
       +
         let author = Link.copyright_author copyright in

     

       104
       104
       +
         let attrs = [(("", "author"), author)] in

     

       185
       105
        
         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

     

       106
       106
       +
         let* () = output_optional_int_element writer "year" (Link.copyright_year copyright) in

     

       107
       107
       +
         let* () = output_optional_text_element writer "license" (Link.copyright_license copyright) in

     

       190
       108
        
         output_element_end writer

     

       191
       109
        
       

     

       192
       192
       -
       (** Write bounds *)

     

       193
       193
       -
       let write_bounds writer bounds =

     

       110
       110
       +
       (** Write bounds element *)

     

       111
       111
       +
       let output_bounds writer bounds =

     

       112
       112
       +
         let (minlat, minlon, maxlat, maxlon) = Metadata.Bounds.bounds bounds in

     

       194
       113
        
         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));

     

       114
       114
       +
           (("", "minlat"), Printf.sprintf "%.6f" (Coordinate.latitude_to_float minlat));

     

       115
       115
       +
           (("", "minlon"), Printf.sprintf "%.6f" (Coordinate.longitude_to_float minlon));

     

       116
       116
       +
           (("", "maxlat"), Printf.sprintf "%.6f" (Coordinate.latitude_to_float maxlat));

     

       117
       117
       +
           (("", "maxlon"), Printf.sprintf "%.6f" (Coordinate.longitude_to_float maxlon));

     

       199
       118
        
         ] in

     

       200
       119
        
         let* () = output_element_start writer "bounds" attrs in

     

       201
       120
        
         output_element_end writer

     

       202
       121
        
       

     

       203
       203
       -
       (** Write metadata *)

     

       204
       204
       -
       let write_metadata writer (metadata : metadata) =

     

       122
       122
       +
       (** Write extensions element *)

     

       123
       123
       +
       let output_extensions writer extensions =

     

       124
       124
       +
         if extensions = [] then Ok ()

     

       125
       125
       +
         else

     

       126
       126
       +
           let* () = output_element_start writer "extensions" [] in

     

       127
       127
       +
           (* For now, skip writing extension content - would need full extension serialization *)

     

       128
       128
       +
           output_element_end writer

     

       129
       129
       +
       

     

       130
       130
       +
       (** Write metadata element *)

     

       131
       131
       +
       let output_metadata writer metadata =

     

       205
       132
        
         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

     

       133
       133
       +
         let* () = output_optional_text_element writer "name" (Metadata.name metadata) in

     

       134
       134
       +
         let* () = output_optional_text_element writer "desc" (Metadata.description metadata) in

     

       135
       135
       +
         let* () = match Metadata.author metadata with

     

       136
       136
       +
           | Some author -> output_person writer author

     

       137
       137
       +
           | None -> Ok ()

     

       138
       138
       +
         in

     

       139
       139
       +
         let* () = match Metadata.copyright metadata with

     

       140
       140
       +
           | Some copyright -> output_copyright writer copyright

     

       141
       141
       +
           | None -> Ok ()

     

       142
       142
       +
         in

     

       143
       143
       +
         let* () = output_links writer (Metadata.links metadata) in

     

       144
       144
       +
         let* () = output_optional_time_element writer "time" (Metadata.time metadata) in

     

       145
       145
       +
         let* () = output_optional_text_element writer "keywords" (Metadata.keywords metadata) in

     

       146
       146
       +
         let* () = match Metadata.bounds_opt metadata with

     

       147
       147
       +
           | Some bounds -> output_bounds writer bounds

     

       148
       148
       +
           | None -> Ok ()

     

       149
       149
       +
         in

     

       150
       150
       +
         let* () = output_extensions writer (Metadata.extensions metadata) in

     

       225
       151
        
         output_element_end writer

     

       226
       152
        
       

     

       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

     

       153
       153
       +
       (** Write waypoint elements (used for wpt, rtept, trkpt) *)

     

       154
       154
       +
       let output_waypoint_data writer waypoint =

     

       155
       155
       +
         let* () = output_optional_float_element writer "ele" (Waypoint.elevation waypoint) in

     

       156
       156
       +
         let* () = output_optional_time_element writer "time" (Waypoint.time waypoint) in

     

       157
       157
       +
         let* () = output_optional_degrees_element writer "magvar" (Waypoint.magvar waypoint) in

     

       158
       158
       +
         let* () = output_optional_float_element writer "geoidheight" (Waypoint.geoidheight waypoint) in

     

       159
       159
       +
         let* () = output_optional_text_element writer "name" (Waypoint.name waypoint) in

     

       160
       160
       +
         let* () = output_optional_text_element writer "cmt" (Waypoint.comment waypoint) in

     

       161
       161
       +
         let* () = output_optional_text_element writer "desc" (Waypoint.description waypoint) in

     

       162
       162
       +
         let* () = output_optional_text_element writer "src" (Waypoint.source waypoint) in

     

       163
       163
       +
         let* () = output_links writer (Waypoint.links waypoint) in

     

       164
       164
       +
         let* () = output_optional_text_element writer "sym" (Waypoint.symbol waypoint) in

     

       165
       165
       +
         let* () = output_optional_text_element writer "type" (Waypoint.type_ waypoint) in

     

       166
       166
       +
         let* () = output_optional_fix_element writer "fix" (Waypoint.fix waypoint) in

     

       167
       167
       +
         let* () = output_optional_int_element writer "sat" (Waypoint.sat waypoint) in

     

       168
       168
       +
         let* () = output_optional_float_element writer "hdop" (Waypoint.hdop waypoint) in

     

       169
       169
       +
         let* () = output_optional_float_element writer "vdop" (Waypoint.vdop waypoint) in

     

       170
       170
       +
         let* () = output_optional_float_element writer "pdop" (Waypoint.pdop waypoint) in

     

       171
       171
       +
         let* () = output_optional_float_element writer "ageofdgpsdata" (Waypoint.ageofdgpsdata waypoint) in

     

       172
       172
       +
         let* () = output_optional_int_element writer "dgpsid" (Waypoint.dgpsid waypoint) in

     

       173
       173
       +
         output_extensions writer (Waypoint.extensions waypoint)

     

       174
       174
       +
       

     

       175
       175
       +
       (** Write waypoints *)

     

       176
       176
       +
       let output_waypoints writer waypoints =

     

       177
       177
       +
         let rec write_waypoints = function

     

       178
       178
       +
           | [] -> Ok ()

     

       179
       179
       +
           | wpt :: rest ->

     

       180
       180
       +
               let lat = Coordinate.latitude_to_float (Waypoint.lat wpt) in

     

       181
       181
       +
               let lon = Coordinate.longitude_to_float (Waypoint.lon wpt) in

     

       182
       182
       +
               let attrs = [

     

       183
       183
       +
                 (("", "lat"), Printf.sprintf "%.6f" lat);

     

       184
       184
       +
                 (("", "lon"), Printf.sprintf "%.6f" lon);

     

       185
       185
       +
               ] in

     

       186
       186
       +
               let* () = output_element_start writer "wpt" attrs in

     

       187
       187
       +
               let* () = output_waypoint_data writer wpt in

     

       188
       188
       +
               let* () = output_element_end writer in

     

       189
       189
       +
               write_waypoints rest

     

       250
       190
        
         in

     

       251
       251
       -
         output_element_end writer

     

       191
       191
       +
         write_waypoints waypoints

     

       252
       192
        
       

     

       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

     

       193
       193
       +
       (** Write route points *)

     

       194
       194
       +
       let output_route_points writer points element_name =

     

       195
       195
       +
         let rec write_points = function

     

       196
       196
       +
           | [] -> Ok ()

     

       197
       197
       +
           | pt :: rest ->

     

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

     

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

     

       200
       200
       +
               let attrs = [

     

       201
       201
       +
                 (("", "lat"), Printf.sprintf "%.6f" lat);

     

       202
       202
       +
                 (("", "lon"), Printf.sprintf "%.6f" lon);

     

       203
       203
       +
               ] in

     

       204
       204
       +
               let* () = output_element_start writer element_name attrs in

     

       205
       205
       +
               let* () = output_waypoint_data writer pt in

     

       206
       206
       +
               let* () = output_element_end writer in

     

       207
       207
       +
               write_points rest

     

       264
       208
        
         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

     

       209
       209
       +
         write_points points

     

       271
       210
        
       

     

       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

     

       211
       211
       +
       (** Write routes *)

     

       212
       212
       +
       let output_routes writer routes =

     

       213
       213
       +
         let rec write_routes = function

     

       214
       214
       +
           | [] -> Ok ()

     

       215
       215
       +
           | route :: rest ->

     

       216
       216
       +
               let* () = output_element_start writer "rte" [] in

     

       217
       217
       +
               let* () = output_optional_text_element writer "name" (Route.name route) in

     

       218
       218
       +
               let* () = output_optional_text_element writer "cmt" (Route.comment route) in

     

       219
       219
       +
               let* () = output_optional_text_element writer "desc" (Route.description route) in

     

       220
       220
       +
               let* () = output_optional_text_element writer "src" (Route.source route) in

     

       221
       221
       +
               let* () = output_links writer (Route.links route) in

     

       222
       222
       +
               let* () = output_optional_int_element writer "number" (Route.number route) in

     

       223
       223
       +
               let* () = output_optional_text_element writer "type" (Route.type_ route) in

     

       224
       224
       +
               let* () = output_extensions writer (Route.extensions route) in

     

       225
       225
       +
               let* () = output_route_points writer (Route.points route) "rtept" in

     

       226
       226
       +
               let* () = output_element_end writer in

     

       227
       227
       +
               write_routes rest

     

       295
       228
        
         in

     

       296
       296
       -
         output_element_end writer

     

       229
       229
       +
         write_routes routes

     

       297
       230
        
       

     

       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

     

       231
       231
       +
       (** Write track segments *)

     

       232
       232
       +
       let output_track_segments writer segments =

     

       233
       233
       +
         let rec write_segments = function

     

       234
       234
       +
           | [] -> Ok ()

     

       235
       235
       +
           | seg :: rest ->

     

       236
       236
       +
               let* () = output_element_start writer "trkseg" [] in

     

       237
       237
       +
               let* () = output_route_points writer (Track.Segment.points seg) "trkpt" in

     

       238
       238
       +
               let* () = output_extensions writer (Track.Segment.extensions seg) in

     

       239
       239
       +
               let* () = output_element_end writer in

     

       240
       240
       +
               write_segments rest

     

       320
       241
        
         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

     

       242
       242
       +
         write_segments segments

     

       243
       243
       +
       

     

       244
       244
       +
       (** Write tracks *)

     

       245
       245
       +
       let output_tracks writer tracks =

     

       246
       246
       +
         let rec write_tracks = function

     

       247
       247
       +
           | [] -> Ok ()

     

       248
       248
       +
           | track :: rest ->

     

       249
       249
       +
               let* () = output_element_start writer "trk" [] in

     

       250
       250
       +
               let* () = output_optional_text_element writer "name" (Track.name track) in

     

       251
       251
       +
               let* () = output_optional_text_element writer "cmt" (Track.comment track) in

     

       252
       252
       +
               let* () = output_optional_text_element writer "desc" (Track.description track) in

     

       253
       253
       +
               let* () = output_optional_text_element writer "src" (Track.source track) in

     

       254
       254
       +
               let* () = output_links writer (Track.links track) in

     

       255
       255
       +
               let* () = output_optional_int_element writer "number" (Track.number track) in

     

       256
       256
       +
               let* () = output_optional_text_element writer "type" (Track.type_ track) in

     

       257
       257
       +
               let* () = output_extensions writer (Track.extensions track) in

     

       258
       258
       +
               let* () = output_track_segments writer (Track.segments track) in

     

       259
       259
       +
               let* () = output_element_end writer in

     

       260
       260
       +
               write_tracks rest

     

       329
       261
        
         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

     

       262
       262
       +
         write_tracks tracks

     

       263
       263
       +
       

     

       264
       264
       +
       (** Write a complete GPX document *)

     

       265
       265
       +
       let write ?(validate=false) output gpx =

     

       266
       266
       +
         let writer = Xmlm.make_output output in

     

       267
       267
       +
         

     

       268
       268
       +
         let result =

     

       269
       269
       +
           try

     

       270
       270
       +
             (* Write XML declaration and GPX root element *)

     

       271
       271
       +
             let version = Doc.version gpx in

     

       272
       272
       +
             let creator = Doc.creator gpx in

     

       273
       273
       +
             let attrs = [

     

       274
       274
       +
               (("", "version"), version);

     

       275
       275
       +
               (("", "creator"), creator);

     

       276
       276
       +
               (("", "xsi:schemaLocation"), "http://www.topografix.com/GPX/1/1 http://www.topografix.com/GPX/1/1/gpx.xsd");

     

       277
       277
       +
               (("xmlns", "xsi"), "http://www.w3.org/2001/XMLSchema-instance");

     

       278
       278
       +
               (("", "xmlns"), "http://www.topografix.com/GPX/1/1")

     

       279
       279
       +
             ] in

     

       280
       280
       +
             

     

       281
       281
       +
             let* () = output_element_start writer "gpx" attrs in

     

       282
       282
       +
             

     

       283
       283
       +
             (* Write metadata if present *)

     

       284
       284
       +
             let* () = match Doc.metadata gpx with

     

       285
       285
       +
               | Some metadata -> output_metadata writer metadata

     

       286
       286
       +
               | None -> Ok ()

     

       287
       287
       +
             in

     

       288
       288
       +
             

     

       289
       289
       +
             (* Write waypoints *)

     

       290
       290
       +
             let* () = output_waypoints writer (Doc.waypoints gpx) in

     

       291
       291
       +
             

     

       292
       292
       +
             (* Write routes *)

     

       293
       293
       +
             let* () = output_routes writer (Doc.routes gpx) in

     

       294
       294
       +
             

     

       295
       295
       +
             (* Write tracks *)

     

       296
       296
       +
             let* () = output_tracks writer (Doc.tracks gpx) in

     

       297
       297
       +
             

     

       298
       298
       +
             (* Write root-level extensions *)

     

       299
       299
       +
             let* () = output_extensions writer (Doc.extensions gpx) in

     

       300
       300
       +
             

     

       301
       301
       +
             output_element_end writer

     

       302
       302
       +
             

     

       303
       303
       +
           with

     

       304
       304
       +
           | Xmlm.Error ((line, col), error) ->

     

       305
       305
       +
             Error (Error.xml_error (Printf.sprintf "XML error at line %d, column %d: %s"

     

       306
       306
       +
                              line col (Xmlm.error_message error)))

     

       307
       307
       +
           | exn ->

     

       308
       308
       +
             Error (Error.xml_error (Printexc.to_string exn))

     

       338
       309
        
         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 output gpx =

     

       348
       348
       -
         let writer = make_writer output in

     

       349
       349
       -
         write_gpx writer gpx

     

       310
       310
       +
         

     

       311
       311
       +
         match result, validate with

     

       312
       312
       +
         | Ok (), true ->

     

       313
       313
       +
           let validation = Validate.validate_gpx gpx in

     

       314
       314
       +
           if validation.is_valid then

     

       315
       315
       +
             Ok ()

     

       316
       316
       +
           else

     

       317
       317
       +
             let error_msgs = List.filter (fun issue -> issue.Validate.level = `Error) validation.issues

     

       318
       318
       +
                             |> List.map (fun issue -> issue.Validate.message)

     

       319
       319
       +
                             |> String.concat "; " in

     

       320
       320
       +
             Error (Error.validation_error error_msgs)

     

       321
       321
       +
         | result, false -> result

     

       322
       322
       +
         | Error _ as result, true -> result (* Pass through write errors even when validating *)

     

       350
       323
        
       

     

       351
       351
       -
       (** Write to string *)

     

       352
       352
       -
       let write_string gpx =

     

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

     

       325
       325
       +
       let write_string ?(validate=false) gpx =

     

       353
       326
        
         let buffer = Buffer.create 1024 in

     

       354
       354
       -
         let output = Xmlm.make_output (`Buffer buffer) in

     

       355
       355
       -
         let result = write output gpx in

     

       356
       356
       -
         match result with

     

       357
       357
       -
         | Ok () -> Ok (Buffer.contents buffer)

     

       358
       358
       -
         | Error e -> Error e
     

       327
       327
       +
         let dest = `Buffer buffer in

     

       328
       328
       +
         let* () = write ~validate dest gpx in

     

       329
       329
       +
         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 : Xmlm.output -> gpx -> unit result

     

       4
       4
       +
       val write : ?validate:bool -> Xmlm.dest -> Doc.t -> (unit, Error.t) result

     

       7
       5
        
       

     

       8
       6
        
       (** Write a GPX document to a string *)

     

       9
       9
       -
       val write_string : gpx -> string result
     

       7
       7
       +
       val write_string : ?validate:bool -> Doc.t -> (string, Error.t) result

+1 -1

lib/gpx_eio/dune

···

       2
       2
        
        (public_name mlgpx.eio)

     

       3
       3
        
        (name gpx_eio)

     

       4
       4
        
        (libraries eio xmlm ptime gpx)

     

       5
       5
       -
        (modules gpx_io gpx_eio))
     

       5
       5
       +
        (modules gpx_io gpx_eio))

+11 -141

lib/gpx_eio/gpx_eio.ml

···

       1
       1
       -
       (** High-level Eio API for GPX operations *)

     

       1
       1
       +
       (** Eio API for GPX operations *)

     

       2
       2
        
       

     

       3
       3
       -
       (* I/O module *)

     

       4
       3
        
       module IO = Gpx_io

     

       5
       5
       -
       

     

       6
       6
       -
       (** Convenience functions for common operations *)

     

       7
       4
        
       

     

       8
       5
        
       (** Read and parse GPX file *)

     

       9
       9
       -
       let read ~fs path = IO.read_file ~fs path

     

       10
       10
       -
       

     

       11
       11
       -
       (** Read and parse GPX file with validation *)

     

       12
       12
       -
       let read_validated ~fs path = IO.read_file_validated ~fs path

     

       6
       6
       +
       let read ?(validate=false) ~fs path = IO.read_file ~validate ~fs path

     

       13
       7
        
       

     

       14
       8
        
       (** Write GPX to file *)

     

       15
       15
       -
       let write ~fs path gpx = IO.write_file ~fs path gpx

     

       16
       16
       -
       

     

       17
       17
       -
       (** Write GPX to file with validation *)

     

       18
       18
       -
       let write_validated ~fs path gpx = IO.write_file_validated ~fs path gpx

     

       9
       9
       +
       let write ?(validate=false) ~fs path gpx = IO.write_file ~validate ~fs path gpx

     

       19
       10
        
       

     

       20
       11
        
       (** Write GPX to file with backup *)

     

       21
       21
       -
       let write_with_backup ~fs path gpx = IO.write_file_with_backup ~fs path gpx

     

       12
       12
       +
       let write_with_backup ?(validate=false) ~fs path gpx = IO.write_file_with_backup ~validate ~fs path gpx

     

       22
       13
        
       

     

       23
       14
        
       (** Read GPX from Eio source *)

     

       24
       24
       -
       let from_source source = IO.read_source source

     

       15
       15
       +
       let from_source ?(validate=false) source = IO.read_source ~validate source

     

       25
       16
        
       

     

       26
       17
        
       (** Write GPX to Eio sink *)

     

       27
       27
       -
       let to_sink sink gpx = IO.write_sink sink gpx

     

       28
       28
       -
       

     

       29
       29
       -
       (** Read GPX from Eio source with validation *)

     

       30
       30
       -
       let from_source_validated source = IO.read_source_validated source

     

       31
       31
       -
       

     

       32
       32
       -
       (** Write GPX to Eio sink with validation *)

     

       33
       33
       -
       let to_sink_validated sink gpx = IO.write_sink_validated sink gpx

     

       34
       34
       -
       

     

       35
       35
       -
       (** Create simple waypoint *)

     

       36
       36
       -
       let make_waypoint ~fs:_ ~lat ~lon ?name ?desc () =

     

       37
       37
       -
         match Gpx.latitude lat, Gpx.longitude lon with

     

       38
       38
       -
         | Ok lat, Ok lon ->

     

       39
       39
       -
           let wpt = Gpx.make_waypoint_data lat lon in

     

       40
       40
       -
           { wpt with name; desc }

     

       41
       41
       -
         | Error e, _ | _, Error e -> raise (Gpx.Gpx_error (Gpx.Invalid_coordinate e))

     

       42
       42
       -
       

     

       43
       43
       -
       (** Create simple track from coordinate list *)

     

       44
       44
       -
       let make_track_from_coords ~fs:_ ~name coords =

     

       45
       45
       -
         let make_trkpt (lat_f, lon_f) =

     

       46
       46
       -
           match Gpx.latitude lat_f, Gpx.longitude lon_f with

     

       47
       47
       -
           | Ok lat, Ok lon -> Gpx.make_waypoint_data lat lon

     

       48
       48
       -
           | Error e, _ | _, Error e -> raise (Gpx.Gpx_error (Gpx.Invalid_coordinate e))

     

       49
       49
       -
         in

     

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

     

       51
       51
       -
         let trkseg : Gpx.track_segment = { trkpts; extensions = [] } in

     

       52
       52
       -
         ({

     

       53
       53
       -
           name = Some name;

     

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

     

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

     

       56
       56
       -
           trksegs = [trkseg];

     

       57
       57
       -
         } : Gpx.track)

     

       58
       58
       -
       

     

       59
       59
       -
       (** Create simple route from coordinate list *)

     

       60
       60
       -
       let make_route_from_coords ~fs:_ ~name coords =

     

       61
       61
       -
         let make_rtept (lat_f, lon_f) =

     

       62
       62
       -
           match Gpx.latitude lat_f, Gpx.longitude lon_f with

     

       63
       63
       -
           | Ok lat, Ok lon -> Gpx.make_waypoint_data lat lon

     

       64
       64
       -
           | Error e, _ | _, Error e -> raise (Gpx.Gpx_error (Gpx.Invalid_coordinate e))

     

       65
       65
       -
         in

     

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

     

       67
       67
       -
         ({

     

       68
       68
       -
           name = Some name;

     

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

     

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

     

       71
       71
       -
           rtepts;

     

       72
       72
       -
         } : Gpx.route)

     

       73
       73
       -
       

     

       74
       74
       -
       (** Extract coordinates from waypoints *)

     

       75
       75
       -
       let waypoint_coords (wpt : Gpx.waypoint_data) =

     

       76
       76
       -
         (Gpx.latitude_to_float wpt.lat, Gpx.longitude_to_float wpt.lon)

     

       77
       77
       -
       

     

       78
       78
       -
       (** Extract coordinates from track *)

     

       79
       79
       -
       let track_coords (track : Gpx.track) =

     

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

     

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

     

       82
       82
       -
             waypoint_coords trkpt :: acc

     

       83
       83
       -
           ) acc trkseg.trkpts

     

       84
       84
       -
         ) [] track.trksegs

     

       85
       85
       -
         |> List.rev

     

       86
       86
       -
       

     

       87
       87
       -
       (** Extract coordinates from route *)

     

       88
       88
       -
       let route_coords (route : Gpx.route) =

     

       89
       89
       -
         List.map waypoint_coords route.rtepts

     

       90
       90
       -
       

     

       91
       91
       -
       (** Count total points in GPX *)

     

       92
       92
       -
       let count_points (gpx : Gpx.gpx) =

     

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

     

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

     

       95
       95
       -
           acc + List.length route.rtepts

     

       96
       96
       -
         ) 0 gpx.routes in

     

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

     

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

     

       99
       99
       -
             acc + List.length trkseg.trkpts

     

       100
       100
       -
           ) acc track.trksegs

     

       101
       101
       -
         ) 0 gpx.tracks in

     

       102
       102
       -
         waypoint_count + route_count + track_count

     

       103
       103
       -
       

     

       104
       104
       -
       (** Get GPX statistics *)

     

       105
       105
       -
       type gpx_stats = {

     

       106
       106
       -
         waypoint_count : int;

     

       107
       107
       -
         route_count : int;

     

       108
       108
       -
         track_count : int;

     

       109
       109
       -
         total_points : int;

     

       110
       110
       -
         has_elevation : bool;

     

       111
       111
       -
         has_time : bool;

     

       112
       112
       -
       }

     

       113
       113
       -
       

     

       114
       114
       -
       let get_stats (gpx : Gpx.gpx) =

     

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

     

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

     

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

     

       118
       118
       -
         let total_points = count_points gpx in

     

       119
       119
       -
         

     

       120
       120
       -
         let has_elevation = 

     

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

     

       122
       122
       -
           List.exists (fun (route : Gpx.route) -> 

     

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

     

       124
       124
       -
           ) gpx.routes ||

     

       125
       125
       -
           List.exists (fun (track : Gpx.track) ->

     

       126
       126
       -
             List.exists (fun (trkseg : Gpx.track_segment) ->

     

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

     

       128
       128
       -
             ) track.trksegs

     

       129
       129
       -
           ) gpx.tracks

     

       130
       130
       -
         in

     

       131
       131
       -
         

     

       132
       132
       -
         let has_time =

     

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

     

       134
       134
       -
           List.exists (fun (route : Gpx.route) ->

     

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

     

       136
       136
       -
           ) gpx.routes ||

     

       137
       137
       -
           List.exists (fun (track : Gpx.track) ->

     

       138
       138
       -
             List.exists (fun (trkseg : Gpx.track_segment) ->

     

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

     

       140
       140
       -
             ) track.trksegs

     

       141
       141
       -
           ) gpx.tracks

     

       142
       142
       -
         in

     

       143
       143
       -
         

     

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

     

       18
       18
       +
       let to_sink ?(validate=false) sink gpx = IO.write_sink ~validate sink gpx

     

       145
       19
        
       

     

       146
       20
        
       (** Pretty print GPX statistics *)

     

       147
       147
       -
       let print_stats (gpx : Gpx.gpx) =

     

       148
       148
       -
         let stats = get_stats gpx in

     

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

     

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

     

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

     

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

     

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

     

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

     

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

       21
       21
       +
       let print_stats sink gpx =

     

       22
       22
       +
         let buf = Buffer.create 256 in

     

       23
       23
       +
         let fmt = Format.formatter_of_buffer buf in

     

       24
       24
       +
         Format.fprintf fmt "%a@?" Gpx.Doc.pp_stats gpx;

     

       25
       25
       +
         Eio.Flow.copy_string (Buffer.contents buf) sink

+23 -115

lib/gpx_eio/gpx_eio.mli

···

       1
       1
       -
       (** {1 GPX Eio - High-level Eio API for GPX operations}

     

       1
       1
       +
       (** {1 Eio API for GPX operations}

     

       2
       2
        
       

     

       3
       3
       -
           This module provides a high-level API for GPX operations using Eio's 

     

       3
       3
       +
           This module provides a direct-style API for GPX operations using Eio's 

     

       4
       4
        
           effects-based concurrent I/O system. It offers convenient functions

     

       5
       5
        
           for common GPX operations while maintaining structured concurrency.

     

       6
       6
        
       

     

       7
       7
       -
           {2 Key Features}

     

       8
       8
       -
       

     

       9
       9
       -
           - Effects-based I/O using Eio

     

       10
       10
       -
           - Structured concurrency compatible

     

       11
       11
       -
           - Resource-safe operations

     

       12
       12
       -
           - Exception-based error handling (raises [Gpx.Gpx_error])

     

       13
       13
       -
           - Concurrent processing capabilities

     

       14
       14
       -
       

     

       15
       7
        
           {2 Usage Example}

     

       16
       8
        
       

     

       17
       9
        
           {[

     
···

       21
       13
        
               let fs = Eio.Stdenv.fs env in

     

       22
       14
        
               

     

       23
       15
        
               (* Create a GPX document *)

     

       24
       24
       -
               let lat = Gpx.latitude 37.7749 |> Result.get_ok in

     

       25
       25
       -
               let lon = Gpx.longitude (-122.4194) |> Result.get_ok in

     

       26
       26
       -
               let wpt = make_waypoint fs ~lat:(Gpx.latitude_to_float lat) ~lon:(Gpx.longitude_to_float lon) ~name:"San Francisco" () in

     

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

     

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

     

       16
       16
       +
               let lat = Gpx.Coordinate.latitude 37.7749 |> Result.get_ok in

     

       17
       17
       +
               let lon = Gpx.Coordinate.longitude (-122.4194) |> Result.get_ok in

     

       18
       18
       +
               let wpt = Gpx.Waypoint.make lat lon |> Gpx.Waypoint.with_name "San Francisco" in

     

       19
       19
       +
               let gpx = Gpx.make_gpx ~creator:"eio-example" |> Gpx.Doc.add_waypoint wpt in

     

       29
       20
        
               

     

       30
       21
        
               (* Write with validation *)

     

       31
       31
       -
               write_validated fs "output.gpx" gpx;

     

       22
       22
       +
               write ~validate:true fs "output.gpx" gpx;

     

       32
       23
        
               

     

       33
       24
        
               (* Read it back *)

     

       34
       34
       -
               let gpx2 = read_validated fs "output.gpx" in

     

       35
       35
       -
               Printf.printf "Read %d waypoints\n" (List.length gpx2.waypoints)

     

       25
       25
       +
               let gpx2 = read ~validate:true fs "output.gpx" in

     

       26
       26
       +
               Printf.printf "Read %d waypoints\n" (List.length (Gpx.Doc.waypoints gpx2))

     

       36
       27
        
       

     

       37
       28
        
             let () = Eio_main.run main

     

       38
       29
        
           ]}

     
···

       44
       35
        
       

     

       45
       36
        
       (** {2 Convenience File Operations}

     

       46
       37
        
       

     

       47
       47
       -
           These functions provide simple file I/O with the filesystem from [Eio.Stdenv.fs]. *)

     

       38
       38
       +
           These functions provide simple file I/O with the filesystem from {!Eio.Stdenv.fs}. *)

     

       48
       39
        
       

     

       49
       40
        
       (** Read and parse GPX file.

     

       50
       41
        
           @param fs Filesystem capability

     

       51
       42
        
           @param path File path to read

     

       43
       43
       +
           @param ?validate Optional validation flag (default: false)

     

       52
       44
        
           @return GPX document

     

       53
       45
        
           @raises Gpx.Gpx_error on read or parse failure *)

     

       54
       54
       -
       val read : fs:[> Eio.Fs.dir_ty ] Eio.Path.t -> string -> Gpx.gpx

     

       55
       55
       -
       

     

       56
       56
       -
       (** Read and parse GPX file with validation.

     

       57
       57
       -
           @param fs Filesystem capability  

     

       58
       58
       -
           @param path File path to read

     

       59
       59
       -
           @return Valid GPX document

     

       60
       60
       -
           @raises Gpx.Gpx_error on validation failure *)

     

       61
       61
       -
       val read_validated : fs:[> Eio.Fs.dir_ty ] Eio.Path.t -> string -> Gpx.gpx

     

       46
       46
       +
       val read : ?validate:bool -> fs:[> Eio.Fs.dir_ty ] Eio.Path.t -> string -> Gpx.t

     

       62
       47
        
       

     

       63
       48
        
       (** Write GPX to file.

     

       64
       49
        
           @param fs Filesystem capability

     

       65
       50
        
           @param path File path to write

     

       66
       51
        
           @param gpx GPX document to write

     

       52
       52
       +
           @param ?validate Optional validation flag (default: false)

     

       67
       53
        
           @raises Gpx.Gpx_error on write failure *)

     

       68
       68
       -
       val write : fs:[> Eio.Fs.dir_ty ] Eio.Path.t -> string -> Gpx.gpx -> unit

     

       69
       69
       -
       

     

       70
       70
       -
       (** Write GPX to file with validation.

     

       71
       71
       -
           @param fs Filesystem capability

     

       72
       72
       -
           @param path File path to write

     

       73
       73
       -
           @param gpx GPX document to write

     

       74
       74
       -
           @raises Gpx.Gpx_error on validation or write failure *)

     

       75
       75
       -
       val write_validated : fs:[> Eio.Fs.dir_ty ] Eio.Path.t -> string -> Gpx.gpx -> unit

     

       54
       54
       +
       val write : ?validate:bool -> fs:[> Eio.Fs.dir_ty ] Eio.Path.t -> string -> Gpx.t -> unit

     

       76
       55
        
       

     

       77
       56
        
       (** Write GPX to file with automatic backup.

     

       78
       57
        
           @param fs Filesystem capability

     

       79
       58
        
           @param path File path to write

     

       80
       59
        
           @param gpx GPX document to write

     

       60
       60
       +
           @param ?validate Optional validation flag (default: false)

     

       81
       61
        
           @return Backup file path (empty if no backup created)

     

       82
       62
        
           @raises Gpx.Gpx_error on failure *)

     

       83
       83
       -
       val write_with_backup : fs:[> Eio.Fs.dir_ty ] Eio.Path.t -> string -> Gpx.gpx -> string

     

       63
       63
       +
       val write_with_backup : ?validate:bool -> fs:[> Eio.Fs.dir_ty ] Eio.Path.t -> string -> Gpx.t -> string

     

       84
       64
        
       

     

       85
       65
        
       (** {2 Stream Operations}

     

       86
       66
        
       

     
···

       88
       68
        
       

     

       89
       69
        
       (** Read GPX from Eio source.

     

       90
       70
        
           @param source Input flow

     

       71
       71
       +
           @param ?validate Optional validation flag (default: false)

     

       91
       72
        
           @return GPX document

     

       92
       73
        
           @raises Gpx.Gpx_error on read or parse failure *)

     

       93
       93
       -
       val from_source : [> Eio.Flow.source_ty ] Eio.Resource.t -> Gpx.gpx

     

       74
       74
       +
       val from_source : ?validate:bool -> [> Eio.Flow.source_ty ] Eio.Resource.t -> Gpx.t

     

       94
       75
        
       

     

       95
       76
        
       (** Write GPX to Eio sink.

     

       96
       77
        
           @param sink Output flow

     

       97
       78
        
           @param gpx GPX document

     

       79
       79
       +
           @param ?validate Optional validation flag (default: false)

     

       98
       80
        
           @raises Gpx.Gpx_error on write failure *)

     

       99
       99
       -
       val to_sink : [> Eio.Flow.sink_ty ] Eio.Resource.t -> Gpx.gpx -> unit

     

       100
       100
       -
       

     

       101
       101
       -
       (** Read GPX from Eio source with validation.

     

       102
       102
       -
           @param source Input flow

     

       103
       103
       -
           @return Valid GPX document

     

       104
       104
       -
           @raises Gpx.Gpx_error on validation failure *)

     

       105
       105
       -
       val from_source_validated : [> Eio.Flow.source_ty ] Eio.Resource.t -> Gpx.gpx

     

       106
       106
       -
       

     

       107
       107
       -
       (** Write GPX to Eio sink with validation.

     

       108
       108
       -
           @param sink Output flow

     

       109
       109
       -
           @param gpx GPX document

     

       110
       110
       -
           @raises Gpx.Gpx_error on validation failure *)

     

       111
       111
       -
       val to_sink_validated : [> Eio.Flow.sink_ty ] Eio.Resource.t -> Gpx.gpx -> unit

     

       112
       112
       -
       

     

       113
       113
       -
       (** {2 Utility Functions} *)

     

       114
       114
       -
       

     

       115
       115
       -
       (** Create simple waypoint with coordinates.

     

       116
       116
       -
           @param fs Filesystem capability (unused, for API consistency)

     

       117
       117
       -
           @param lat Latitude in degrees

     

       118
       118
       -
           @param lon Longitude in degrees  

     

       119
       119
       -
           @param ?name Optional waypoint name

     

       120
       120
       -
           @param ?desc Optional waypoint description

     

       121
       121
       -
           @return Waypoint data

     

       122
       122
       -
           @raises Gpx.Gpx_error on invalid coordinates *)

     

       123
       123
       -
       val make_waypoint : fs:[> Eio.Fs.dir_ty ] Eio.Path.t -> lat:float -> lon:float -> ?name:string -> ?desc:string -> unit -> Gpx.waypoint_data

     

       81
       81
       +
       val to_sink : ?validate:bool -> [> Eio.Flow.sink_ty ] Eio.Resource.t -> Gpx.t -> unit

     

       124
       82
        
       

     

       125
       125
       -
       (** Create track from coordinate list.

     

       126
       126
       -
           @param fs Filesystem capability (unused, for API consistency)

     

       127
       127
       -
           @param name Track name

     

       128
       128
       -
           @param coords List of (latitude, longitude) pairs

     

       129
       129
       -
           @return Track with single segment

     

       130
       130
       -
           @raises Gpx.Gpx_error on invalid coordinates *)

     

       131
       131
       -
       val make_track_from_coords : fs:[> Eio.Fs.dir_ty ] Eio.Path.t -> name:string -> (float * float) list -> Gpx.track

     

       132
       132
       -
       

     

       133
       133
       -
       (** Create route from coordinate list.

     

       134
       134
       -
           @param fs Filesystem capability (unused, for API consistency)

     

       135
       135
       -
           @param name Route name  

     

       136
       136
       -
           @param coords List of (latitude, longitude) pairs

     

       137
       137
       -
           @return Route

     

       138
       138
       -
           @raises Gpx.Gpx_error on invalid coordinates *)

     

       139
       139
       -
       val make_route_from_coords : fs:[> Eio.Fs.dir_ty ] Eio.Path.t -> name:string -> (float * float) list -> Gpx.route

     

       140
       140
       -
       

     

       141
       141
       -
       (** Extract coordinates from waypoint.

     

       142
       142
       -
           @param wpt Waypoint data

     

       143
       143
       -
           @return (latitude, longitude) as floats *)

     

       144
       144
       -
       val waypoint_coords : Gpx.waypoint_data -> float * float

     

       145
       145
       -
       

     

       146
       146
       -
       (** Extract coordinates from track.

     

       147
       147
       -
           @param track Track

     

       148
       148
       -
           @return List of (latitude, longitude) pairs *)

     

       149
       149
       -
       val track_coords : Gpx.track -> (float * float) list

     

       150
       150
       -
       

     

       151
       151
       -
       (** Extract coordinates from route.

     

       152
       152
       -
           @param route Route

     

       153
       153
       -
           @return List of (latitude, longitude) pairs *)

     

       154
       154
       -
       val route_coords : Gpx.route -> (float * float) list

     

       155
       155
       -
       

     

       156
       156
       -
       (** Count total points in GPX document.

     

       157
       157
       -
           @param gpx GPX document

     

       158
       158
       -
           @return Total number of waypoints, route points, and track points *)

     

       159
       159
       -
       val count_points : Gpx.gpx -> int

     

       160
       160
       -
       

     

       161
       161
       -
       (** GPX statistics record *)

     

       162
       162
       -
       type gpx_stats = {

     

       163
       163
       -
         waypoint_count : int;      (** Number of waypoints *)

     

       164
       164
       -
         route_count : int;         (** Number of routes *)

     

       165
       165
       -
         track_count : int;         (** Number of tracks *)

     

       166
       166
       -
         total_points : int;        (** Total geographic points *)

     

       167
       167
       -
         has_elevation : bool;      (** Document contains elevation data *)

     

       168
       168
       -
         has_time : bool;          (** Document contains time data *)

     

       169
       169
       -
       }

     

       170
       170
       -
       

     

       171
       171
       -
       (** Get GPX document statistics.

     

       172
       172
       -
           @param gpx GPX document

     

       173
       173
       -
           @return Statistics summary *)

     

       174
       174
       -
       val get_stats : Gpx.gpx -> gpx_stats

     

       175
       175
       -
       

     

       176
       176
       -
       (** Print GPX statistics to stdout.

     

       83
       83
       +
       (** Print GPX statistics to sink.

     

       84
       84
       +
           @param sink Output sink

     

       177
       85
        
           @param gpx GPX document *)

     

       178
       178
       -
       val print_stats : Gpx.gpx -> unit
     

       86
       86
       +
       val print_stats : [> Eio.Flow.sink_ty ] Eio.Resource.t -> Gpx.t -> unit

+12 -56

lib/gpx_eio/gpx_io.ml

···

       1
       1
        
       (** GPX Eio I/O operations *)

     

       2
       2
        
       

     

       3
       3
       -
       (* Real Eio-based I/O operations *)

     

       4
       4
       -
       

     

       5
       3
        
       (** Read GPX from file path *)

     

       6
       6
       -
       let read_file ~fs path =

     

       4
       4
       +
       let read_file ?(validate=false) ~fs path =

     

       7
       5
        
         let content = Eio.Path.load Eio.Path.(fs / path) in

     

       8
       8
       -
         match Gpx.parse_string content with

     

       6
       6
       +
         match Gpx.parse_string ~validate content with

     

       9
       7
        
         | Ok gpx -> gpx

     

       10
       8
        
         | Error err -> raise (Gpx.Gpx_error err)

     

       11
       9
        
       

     

       12
       10
        
       (** Write GPX to file path *)

     

       13
       13
       -
       let write_file ~fs path gpx =

     

       14
       14
       -
         match Gpx.write_string gpx with

     

       11
       11
       +
       let write_file ?(validate=false) ~fs path gpx =

     

       12
       12
       +
         match Gpx.write_string ~validate gpx with

     

       15
       13
        
         | Ok xml_string -> 

     

       16
       14
        
           Eio.Path.save ~create:(`Or_truncate 0o644) Eio.Path.(fs / path) xml_string

     

       17
       15
        
         | Error err -> raise (Gpx.Gpx_error err)

     

       18
       16
        
       

     

       19
       19
       -
       (** Read GPX from file with validation *)

     

       20
       20
       -
       let read_file_validated ~fs path =

     

       21
       21
       -
         let gpx = read_file ~fs path in

     

       22
       22
       -
         let validation = Gpx.validate_gpx gpx in

     

       23
       23
       -
         if validation.is_valid then

     

       24
       24
       -
           gpx

     

       25
       25
       -
         else

     

       26
       26
       -
           let errors = Gpx.get_errors gpx in

     

       27
       27
       -
           let error_msgs = List.map Gpx.format_issue errors in

     

       28
       28
       -
           raise (Gpx.Gpx_error (Gpx.Validation_error (String.concat "; " error_msgs)))

     

       29
       29
       -
       

     

       30
       30
       -
       (** Write GPX to file with validation *)

     

       31
       31
       -
       let write_file_validated ~fs path gpx =

     

       32
       32
       -
         let validation = Gpx.validate_gpx gpx in

     

       33
       33
       -
         if not validation.is_valid then

     

       34
       34
       -
           let errors = Gpx.get_errors gpx in

     

       35
       35
       -
           let error_msgs = List.map Gpx.format_issue errors in

     

       36
       36
       -
           raise (Gpx.Gpx_error (Gpx.Validation_error (String.concat "; " error_msgs)))

     

       37
       37
       -
         else

     

       38
       38
       -
           write_file ~fs path gpx

     

       39
       39
       -
       

     

       40
       17
        
       (** Read GPX from Eio source *)

     

       41
       41
       -
       let read_source source =

     

       18
       18
       +
       let read_source ?(validate=false) source =

     

       42
       19
        
         let content = Eio.Flow.read_all source in

     

       43
       43
       -
         match Gpx.parse_string content with

     

       20
       20
       +
         match Gpx.parse_string ~validate content with

     

       44
       21
        
         | Ok gpx -> gpx

     

       45
       22
        
         | Error err -> raise (Gpx.Gpx_error err)

     

       46
       23
        
       

     

       47
       24
        
       (** Write GPX to Eio sink *)

     

       48
       48
       -
       let write_sink sink gpx =

     

       49
       49
       -
         match Gpx.write_string gpx with

     

       25
       25
       +
       let write_sink ?(validate=false) sink gpx =

     

       26
       26
       +
         match Gpx.write_string ~validate gpx with

     

       50
       27
        
         | Ok xml_string -> 

     

       51
       28
        
           Eio.Flow.copy_string xml_string sink

     

       52
       29
        
         | Error err -> raise (Gpx.Gpx_error err)

     

       53
       30
        
       

     

       54
       54
       -
       (** Read GPX from Eio source with validation *)

     

       55
       55
       -
       let read_source_validated source =

     

       56
       56
       -
         let gpx = read_source source in

     

       57
       57
       -
         let validation = Gpx.validate_gpx gpx in

     

       58
       58
       -
         if validation.is_valid then

     

       59
       59
       -
           gpx

     

       60
       60
       -
         else

     

       61
       61
       -
           let errors = Gpx.get_errors gpx in

     

       62
       62
       -
           let error_msgs = List.map Gpx.format_issue errors in

     

       63
       63
       -
           raise (Gpx.Gpx_error (Gpx.Validation_error (String.concat "; " error_msgs)))

     

       64
       64
       -
       

     

       65
       65
       -
       (** Write GPX to Eio sink with validation *)

     

       66
       66
       -
       let write_sink_validated sink gpx =

     

       67
       67
       -
         let validation = Gpx.validate_gpx gpx in

     

       68
       68
       -
         if not validation.is_valid then

     

       69
       69
       -
           let errors = Gpx.get_errors gpx in

     

       70
       70
       -
           let error_msgs = List.map Gpx.format_issue errors in

     

       71
       71
       -
           raise (Gpx.Gpx_error (Gpx.Validation_error (String.concat "; " error_msgs)))

     

       72
       72
       -
         else

     

       73
       73
       -
           write_sink sink gpx

     

       74
       74
       -
       

     

       75
       31
        
       (** Check if file exists *)

     

       76
       32
        
       let file_exists ~fs path =

     

       77
       33
        
         try

     
···

       86
       42
        
           let stat = Eio.Path.stat ~follow:true Eio.Path.(fs / path) in

     

       87
       43
        
           Optint.Int63.to_int stat.size

     

       88
       44
        
         with

     

       89
       89
       -
         | exn -> raise (Gpx.Gpx_error (Gpx.IO_error (Printexc.to_string exn)))

     

       45
       45
       +
         | exn -> raise (Gpx.Gpx_error (Gpx.Error.io_error (Printexc.to_string exn)))

     

       90
       46
        
       

     

       91
       47
        
       (** Create backup of existing file *)

     

       92
       48
        
       let create_backup ~fs path =

     
···

       99
       55
        
           ""

     

       100
       56
        
       

     

       101
       57
        
       (** Write GPX to file with automatic backup *)

     

       102
       102
       -
       let write_file_with_backup ~fs path gpx =

     

       58
       58
       +
       let write_file_with_backup ?(validate=false) ~fs path gpx =

     

       103
       59
        
         let backup_path = create_backup ~fs path in

     

       104
       60
        
         try

     

       105
       105
       -
           write_file ~fs path gpx;

     

       61
       61
       +
           write_file ~validate ~fs path gpx;

     

       106
       62
        
           backup_path

     

       107
       63
        
         with

     

       108
       64
        
         | Gpx.Gpx_error _ as err ->

     
···

       113
       69
        
               Eio.Path.save ~create:(`Or_truncate 0o644) Eio.Path.(fs / path) backup_content

     

       114
       70
        
             with _ -> () (* Ignore restore errors *)

     

       115
       71
        
           );

     

       116
       116
       -
           raise err
     

       72
       72
       +
           raise err

+11 -34

lib/gpx_eio/gpx_io.mli

···

       5
       5
        
           compatible and work with Eio's resource management.

     

       6
       6
        
       *)

     

       7
       7
        
       

     

       8
       8
       -
       (** {1 File Operations}

     

       9
       9
       -
       

     

       10
       10
       -
           All file operations require filesystem access capability. *)

     

       8
       8
       +
       (** {1 File Operations} *)

     

       11
       9
        
       

     

       12
       10
        
       (** Read GPX from file path.

     

       13
       11
        
           @param fs Filesystem capability

     

       14
       12
        
           @param path File path to read

     

       13
       13
       +
           @param ?validate Optional validation flag (default: false)

     

       15
       14
        
           @return GPX document or error *)

     

       16
       16
       -
       val read_file : 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

     

       17
       16
        
       

     

       18
       17
        
       (** Write GPX to file path.

     

       19
       18
        
           @param fs Filesystem capability  

     

       20
       19
        
           @param path File path to write

     

       21
       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 : fs:[> Eio.Fs.dir_ty ] Eio.Path.t -> string -> Gpx.gpx -> unit

     

       24
       24
       -
       

     

       25
       25
       -
       (** Read GPX from file with validation.

     

       26
       26
       -
           @param fs Filesystem capability

     

       27
       27
       -
           @param path File path to read

     

       28
       28
       -
           @return Valid GPX document

     

       29
       29
       -
           @raises Gpx.Gpx_error on validation failure *)

     

       30
       30
       -
       val read_file_validated : fs:[> Eio.Fs.dir_ty ] Eio.Path.t -> string -> Gpx.gpx

     

       31
       31
       -
       

     

       32
       32
       -
       (** Write GPX to file with validation.

     

       33
       33
       -
           @param fs Filesystem capability

     

       34
       34
       -
           @param path File path to write

     

       35
       35
       -
           @param gpx GPX document to write

     

       36
       36
       -
           @raises Gpx.Gpx_error on validation or write failure *)

     

       37
       37
       -
       val write_file_validated : 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

     

       38
       24
        
       

     

       39
       25
        
       (** {1 Stream Operations}

     

       40
       26
        
       

     
···

       42
       28
        
       

     

       43
       29
        
       (** Read GPX from Eio source.

     

       44
       30
        
           @param source Input flow to read from

     

       31
       31
       +
           @param ?validate Optional validation flag (default: false)

     

       45
       32
        
           @return GPX document *)

     

       46
       46
       -
       val read_source : [> 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

     

       47
       34
        
       

     

       48
       35
        
       (** Write GPX to Eio sink.

     

       49
       36
        
           @param sink Output flow to write to

     

       50
       50
       -
           @param gpx GPX document to write *)

     

       51
       51
       -
       val write_sink : [> Eio.Flow.sink_ty ] Eio.Resource.t -> Gpx.gpx -> unit

     

       52
       52
       -
       

     

       53
       53
       -
       (** Read GPX from Eio source with validation.

     

       54
       54
       -
           @param source Input flow to read from

     

       55
       55
       -
           @return Valid GPX document

     

       56
       56
       -
           @raises Gpx.Gpx_error on validation failure *)

     

       57
       57
       -
       val read_source_validated : [> Eio.Flow.source_ty ] Eio.Resource.t -> Gpx.gpx

     

       58
       58
       -
       

     

       59
       59
       -
       (** Write GPX to Eio sink with validation.

     

       60
       60
       -
           @param sink Output flow to write to

     

       61
       37
        
           @param gpx GPX document to write

     

       62
       62
       -
           @raises Gpx.Gpx_error on validation failure *)

     

       63
       63
       -
       val write_sink_validated : [> Eio.Flow.sink_ty ] Eio.Resource.t -> Gpx.gpx -> unit

     

       38
       38
       +
           @param ?validate Optional validation flag (default: false) *)

     

       39
       39
       +
       val write_sink : ?validate:bool -> [> Eio.Flow.sink_ty ] Eio.Resource.t -> Gpx.t -> unit

     

       64
       40
        
       

     

       65
       41
        
       (** {1 Utility Functions} *)

     

       66
       42
        
       

     
···

       87
       63
        
           @param fs Filesystem capability

     

       88
       64
        
           @param path File path to write

     

       89
       65
        
           @param gpx GPX document to write

     

       66
       66
       +
           @param ?validate Optional validation flag (default: false)

     

       90
       67
        
           @return Backup file path (empty string if no backup needed) *)

     

       91
       91
       -
       val write_file_with_backup : 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

+1 -1

lib/gpx_unix/dune

···

       2
       2
        
        (public_name mlgpx.unix)

     

       3
       3
        
        (name gpx_unix)

     

       4
       4
        
        (libraries unix xmlm ptime gpx)

     

       5
       5
       -
        (modules gpx_io gpx_unix))
     

       5
       5
       +
        (modules gpx_io gpx_unix))

+18 -41

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

     

       7
       6
        
       

     

       8
       7
        
       (** Read GPX from file *)

     

       9
       9
       -
       let read_file filename =

     

       8
       8
       +
       let read_file ?(validate=false) filename =

     

       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 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
       21
       -
       let write_file filename gpx =

     

       20
       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 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
       33
       -
       let read_stdin () =

     

       32
       32
       +
       let read_stdin ?(validate=false) () =

     

       34
       33
        
         let input = Xmlm.make_input (`Channel stdin) in

     

       35
       35
       -
         Gpx.Parser.parse input

     

       34
       34
       +
         Gpx.parse ~validate input

     

       36
       35
        
       

     

       37
       36
        
       (** Write GPX to stdout *)

     

       38
       38
       -
       let write_stdout gpx =

     

       39
       39
       -
         let output = Xmlm.make_output (`Channel stdout) in

     

       40
       40
       -
         Gpx.Writer.write output gpx

     

       41
       41
       -
       

     

       42
       42
       -
       (** Read GPX from file with validation *)

     

       43
       43
       -
       let read_file_validated filename =

     

       44
       44
       -
         let* gpx = read_file filename in

     

       45
       45
       -
         let validation = Gpx.Validate.validate_gpx gpx in

     

       46
       46
       -
         if validation.is_valid then

     

       47
       47
       -
           Ok gpx

     

       48
       48
       -
         else

     

       49
       49
       -
           let errors = List.filter (fun issue -> issue.Gpx.Validate.level = `Error) validation.issues in

     

       50
       50
       -
           let error_msgs = List.map Gpx.Validate.format_issue errors in

     

       51
       51
       -
           Error (Validation_error (String.concat "; " error_msgs))

     

       52
       52
       -
       

     

       53
       53
       -
       (** Write GPX to file with validation *)

     

       54
       54
       -
       let write_file_validated filename gpx =

     

       55
       55
       -
         let validation = Gpx.Validate.validate_gpx gpx in

     

       56
       56
       -
         if not validation.is_valid then

     

       57
       57
       -
           let errors = List.filter (fun issue -> issue.Gpx.Validate.level = `Error) validation.issues in

     

       58
       58
       -
           let error_msgs = List.map Gpx.Validate.format_issue errors in

     

       59
       59
       -
           Error (Validation_error (String.concat "; " error_msgs))

     

       60
       60
       -
         else

     

       61
       61
       -
           write_file filename gpx

     

       37
       37
       +
       let write_stdout ?(validate=false) gpx =

     

       38
       38
       +
         Gpx.write ~validate (`Channel stdout) gpx

     

       62
       39
        
       

     

       63
       40
        
       (** Check if file exists and is readable *)

     

       64
       41
        
       let file_exists filename =

     
···

       75
       52
        
           Ok stats.st_size

     

       76
       53
        
         with

     

       77
       54
        
         | Unix.Unix_error (errno, _, _) -> 

     

       78
       78
       -
           Error (IO_error (Unix.error_message errno))

     

       55
       55
       +
           Error (Gpx.Error.io_error (Unix.error_message errno))

     

       79
       56
        
       

     

       80
       57
        
       (** Create backup of file before overwriting *)

     

       81
       58
        
       let create_backup filename =

     
···

       94
       71
        
             close_out oc;

     

       95
       72
        
             Ok backup_name

     

       96
       73
        
           with

     

       97
       97
       -
           | Sys_error msg -> Error (IO_error msg)

     

       98
       98
       -
           | 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))

     

       99
       76
        
         else

     

       100
       77
        
           Ok ""

     

       101
       78
        
       

     

       102
       79
        
       (** Write GPX to file with backup *)

     

       103
       103
       -
       let write_file_with_backup filename gpx =

     

       80
       80
       +
       let write_file_with_backup ?(validate=false) filename gpx =

     

       104
       81
        
         let* backup_name = create_backup filename in

     

       105
       105
       -
         match write_file filename gpx with

     

       82
       82
       +
         match write_file ~validate filename gpx with

     

       106
       83
        
         | Ok () -> Ok backup_name

     

       107
       84
        
         | Error _ as err ->

     

       108
       85
        
           (* Try to restore backup if write failed *)

+8 -14

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 : 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 : 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 : 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 : gpx -> unit result

     

       16
       16
       -
       

     

       17
       17
       -
       (** Read GPX from file with validation *)

     

       18
       18
       -
       val read_file_validated : string -> gpx result

     

       19
       19
       -
       

     

       20
       20
       -
       (** Write GPX to file with validation *)

     

       21
       21
       -
       val write_file_validated : string -> gpx -> unit result

     

       15
       15
       +
       val write_stdout : ?validate:bool -> t -> (unit, Gpx.error) result

     

       22
       16
        
       

     

       23
       17
        
       (** Check if file exists and is readable *)

     

       24
       18
        
       val file_exists : string -> bool

     

       25
       19
        
       

     

       26
       20
        
       (** Get file size *)

     

       27
       27
       -
       val file_size : string -> int result

     

       21
       21
       +
       val file_size : string -> (int, Gpx.error) result

     

       28
       22
        
       

     

       29
       23
        
       (** Create backup of file before overwriting *)

     

       30
       30
       -
       val create_backup : string -> string result

     

       24
       24
       +
       val create_backup : string -> (string, Gpx.error) result

     

       31
       25
        
       

     

       32
       26
        
       (** Write GPX to file with backup *)

     

       33
       33
       -
       val write_file_with_backup : string -> gpx -> string result
     

       27
       27
       +
       val write_file_with_backup : ?validate:bool -> string -> t -> (string, Gpx.error) result

+3 -163

lib/gpx_unix/gpx_unix.ml

···

       1
       1
       -
       (** High-level Unix API for GPX operations *)

     

       2
       2
       -
       

     

       3
       3
       -
       (** Result binding operators *)

     

       4
       4
       -
       let (let*) = Result.bind

     

       1
       1
       +
       (** Unix API for GPX operations *)

     

       5
       2
        
       

     

       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

     

       11
       3
        
       module IO = Gpx_io

     

       12
       12
       -
       

     

       13
       13
       -
       (* Re-export common types *)

     

       14
       14
       -
       open Gpx.Types

     

       4
       4
       +
       open Gpx

     

       15
       5
        
       

     

       16
       6
        
       (** Convenience functions for common operations *)

     

       17
       7
        
       

     

       18
       8
        
       (** Read and parse GPX file *)

     

       19
       9
        
       let read = IO.read_file

     

       20
       10
        
       

     

       21
       21
       -
       (** Read and parse GPX file with validation *)

     

       22
       22
       -
       let read_validated = IO.read_file_validated

     

       23
       23
       -
       

     

       24
       11
        
       (** Write GPX to file *)

     

       25
       12
        
       let write = IO.write_file

     

       26
       13
        
       

     

       27
       27
       -
       (** Write GPX to file with validation *)

     

       28
       28
       -
       let write_validated = IO.write_file_validated

     

       29
       29
       -
       

     

       30
       14
        
       (** Write GPX to file with backup *)

     

       31
       15
        
       let write_with_backup = IO.write_file_with_backup

     

       32
       16
        
       

     

       33
       33
       -
       (** Convert GPX to string *)

     

       34
       34
       -
       let to_string = Writer.write_string

     

       35
       35
       -
       

     

       36
       36
       -
       (** Parse GPX from string *)

     

       37
       37
       -
       let from_string = Parser.parse_string

     

       38
       38
       -
       

     

       39
       39
       -
       (** Quick validation check *)

     

       40
       40
       -
       let is_valid = Validate.is_valid

     

       41
       41
       -
       

     

       42
       42
       -
       (** Get validation issues *)

     

       43
       43
       -
       let validate = Validate.validate_gpx

     

       44
       44
       -
       

     

       45
       45
       -
       (** Create simple waypoint *)

     

       46
       46
       -
       let make_waypoint ~lat ~lon ?name ?desc () =

     

       47
       47
       -
         match (latitude lat, longitude lon) with

     

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

     

       49
       49
       -
           let wpt = make_waypoint_data lat lon in

     

       50
       50
       -
           Ok { wpt with name; desc }

     

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

     

       52
       52
       -
       

     

       53
       53
       -
       (** Create simple track from coordinate list *)

     

       54
       54
       -
       let make_track_from_coords ~name coords =

     

       55
       55
       -
         let make_trkpt (lat, lon) =

     

       56
       56
       -
           match (latitude lat, longitude lon) with

     

       57
       57
       -
           | (Ok lat, Ok lon) -> Ok (make_waypoint_data lat lon)

     

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

     

       59
       59
       -
         in

     

       60
       60
       -
         let rec convert_coords acc = function

     

       61
       61
       -
           | [] -> Ok (List.rev acc)

     

       62
       62
       -
           | coord :: rest ->

     

       63
       63
       -
             match make_trkpt coord with

     

       64
       64
       -
             | Ok trkpt -> convert_coords (trkpt :: acc) rest

     

       65
       65
       -
             | Error e -> Error e

     

       66
       66
       -
         in

     

       67
       67
       -
         let* trkpts = convert_coords [] coords in

     

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

     

       69
       69
       -
         Ok {

     

       70
       70
       -
           name = Some name;

     

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

     

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

     

       73
       73
       -
           trksegs = [trkseg];

     

       74
       74
       -
         }

     

       75
       75
       -
       

     

       76
       76
       -
       (** Create simple route from coordinate list *)

     

       77
       77
       -
       let make_route_from_coords ~name coords =

     

       78
       78
       -
         let make_rtept (lat, lon) =

     

       79
       79
       -
           match (latitude lat, longitude lon) with

     

       80
       80
       -
           | (Ok lat, Ok lon) -> Ok (make_waypoint_data lat lon)

     

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

     

       82
       82
       -
         in

     

       83
       83
       -
         let rec convert_coords acc = function

     

       84
       84
       -
           | [] -> Ok (List.rev acc)

     

       85
       85
       -
           | coord :: rest ->

     

       86
       86
       -
             match make_rtept coord with

     

       87
       87
       -
             | Ok rtept -> convert_coords (rtept :: acc) rest

     

       88
       88
       -
             | Error e -> Error e

     

       89
       89
       -
         in

     

       90
       90
       -
         let* rtepts = convert_coords [] coords in

     

       91
       91
       -
         Ok {

     

       92
       92
       -
           name = Some name;

     

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

     

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

     

       95
       95
       -
           rtepts;

     

       96
       96
       -
         }

     

       97
       97
       -
       

     

       98
       98
       -
       (** Extract coordinates from waypoints *)

     

       99
       99
       -
       let waypoint_coords wpt =

     

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

     

       101
       101
       -
       

     

       102
       102
       -
       (** Extract coordinates from track *)

     

       103
       103
       -
       let track_coords track =

     

       104
       104
       -
         List.fold_left (fun acc trkseg ->

     

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

     

       106
       106
       -
             waypoint_coords trkpt :: acc

     

       107
       107
       -
           ) acc trkseg.trkpts

     

       108
       108
       -
         ) [] track.trksegs

     

       109
       109
       -
         |> List.rev

     

       110
       110
       -
       

     

       111
       111
       -
       (** Extract coordinates from route *)

     

       112
       112
       -
       let route_coords route =

     

       113
       113
       -
         List.map waypoint_coords route.rtepts

     

       114
       114
       -
       

     

       115
       115
       -
       (** Count total points in GPX *)

     

       116
       116
       -
       let count_points gpx =

     

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

     

       118
       118
       -
         let route_count = List.fold_left (fun acc route ->

     

       119
       119
       -
           acc + List.length route.rtepts

     

       120
       120
       -
         ) 0 gpx.routes in

     

       121
       121
       -
         let track_count = List.fold_left (fun acc track ->

     

       122
       122
       -
           List.fold_left (fun acc trkseg ->

     

       123
       123
       -
             acc + List.length trkseg.trkpts

     

       124
       124
       -
           ) acc track.trksegs

     

       125
       125
       -
         ) 0 gpx.tracks in

     

       126
       126
       -
         waypoint_count + route_count + track_count

     

       127
       127
       -
       

     

       128
       128
       -
       (** Get GPX statistics *)

     

       129
       129
       -
       type gpx_stats = {

     

       130
       130
       -
         waypoint_count : int;

     

       131
       131
       -
         route_count : int;

     

       132
       132
       -
         track_count : int;

     

       133
       133
       -
         total_points : int;

     

       134
       134
       -
         has_elevation : bool;

     

       135
       135
       -
         has_time : bool;

     

       136
       136
       -
       }

     

       137
       137
       -
       

     

       138
       138
       -
       let get_stats gpx =

     

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

     

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

     

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

     

       142
       142
       -
         let total_points = count_points gpx in

     

       143
       143
       -
         

     

       144
       144
       -
         let has_elevation = 

     

       145
       145
       -
           List.exists (fun wpt -> wpt.ele <> None) gpx.waypoints ||

     

       146
       146
       -
           List.exists (fun route -> 

     

       147
       147
       -
             List.exists (fun rtept -> rtept.ele <> None) route.rtepts

     

       148
       148
       -
           ) gpx.routes ||

     

       149
       149
       -
           List.exists (fun track ->

     

       150
       150
       -
             List.exists (fun trkseg ->

     

       151
       151
       -
               List.exists (fun trkpt -> trkpt.ele <> None) trkseg.trkpts

     

       152
       152
       -
             ) track.trksegs

     

       153
       153
       -
           ) gpx.tracks

     

       154
       154
       -
         in

     

       155
       155
       -
         

     

       156
       156
       -
         let has_time =

     

       157
       157
       -
           List.exists (fun wpt -> wpt.time <> None) gpx.waypoints ||

     

       158
       158
       -
           List.exists (fun route ->

     

       159
       159
       -
             List.exists (fun rtept -> rtept.time <> None) route.rtepts

     

       160
       160
       -
           ) gpx.routes ||

     

       161
       161
       -
           List.exists (fun track ->

     

       162
       162
       -
             List.exists (fun trkseg ->

     

       163
       163
       -
               List.exists (fun trkpt -> trkpt.time <> None) trkseg.trkpts

     

       164
       164
       -
             ) track.trksegs

     

       165
       165
       -
           ) gpx.tracks

     

       166
       166
       -
         in

     

       167
       167
       -
         

     

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

     

       169
       169
       -
       

     

       170
       17
        
       (** Pretty print GPX statistics *)

     

       171
       18
        
       let print_stats gpx =

     

       172
       172
       -
         let stats = get_stats gpx in

     

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

     

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

     

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

     

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

     

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

     

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

     

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

       19
       19
       +
         Format.printf "%a@." Doc.pp_stats gpx

+6 -68

lib/gpx_unix/gpx_unix.mli

···

       1
       1
       -
       (** High-level Unix API for GPX operations *)

     

       1
       1
       +
       (** 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

     

       8
       8
       -
       module IO = Gpx_io

     

       9
       9
       -
       

     

       10
       10
       -
       (* Re-export common types *)

     

       11
       11
       -
       open Gpx.Types

     

       12
       12
       -
       

     

       13
       13
       -
       (** Convenience functions for common operations *)

     

       3
       3
       +
       open Gpx

     

       14
       4
        
       

     

       15
       5
        
       (** Read and parse GPX file *)

     

       16
       16
       -
       val read : string -> gpx result

     

       17
       17
       -
       

     

       18
       18
       -
       (** Read and parse GPX file with validation *)

     

       19
       19
       -
       val read_validated : string -> gpx result

     

       6
       6
       +
       val read : ?validate:bool -> string -> (t, error) result

     

       20
       7
        
       

     

       21
       8
        
       (** Write GPX to file *)

     

       22
       22
       -
       val write : string -> gpx -> unit result

     

       23
       23
       -
       

     

       24
       24
       -
       (** Write GPX to file with validation *)

     

       25
       25
       -
       val write_validated : string -> gpx -> unit result

     

       9
       9
       +
       val write : ?validate:bool -> string -> t -> (unit, error) result

     

       26
       10
        
       

     

       27
       11
        
       (** Write GPX to file with backup *)

     

       28
       28
       -
       val write_with_backup : string -> gpx -> string result

     

       29
       29
       -
       

     

       30
       30
       -
       (** Convert GPX to string *)

     

       31
       31
       -
       val to_string : gpx -> string result

     

       32
       32
       -
       

     

       33
       33
       -
       (** Parse GPX from string *)

     

       34
       34
       -
       val from_string : string -> gpx result

     

       35
       35
       -
       

     

       36
       36
       -
       (** Quick validation check *)

     

       37
       37
       -
       val is_valid : gpx -> bool

     

       38
       38
       -
       

     

       39
       39
       -
       (** Get validation issues *)

     

       40
       40
       -
       val validate : gpx -> Gpx.Validate.validation_result

     

       41
       41
       -
       

     

       42
       42
       -
       (** Create simple waypoint *)

     

       43
       43
       -
       val make_waypoint : lat:float -> lon:float -> ?name:string -> ?desc:string -> unit -> waypoint result

     

       44
       44
       -
       

     

       45
       45
       -
       (** Create simple track from coordinate list *)

     

       46
       46
       -
       val make_track_from_coords : name:string -> (float * float) list -> track result

     

       47
       47
       -
       

     

       48
       48
       -
       (** Create simple route from coordinate list *)

     

       49
       49
       -
       val make_route_from_coords : name:string -> (float * float) list -> route result

     

       50
       50
       -
       

     

       51
       51
       -
       (** Extract coordinates from waypoints *)

     

       52
       52
       -
       val waypoint_coords : waypoint_data -> float * float

     

       53
       53
       -
       

     

       54
       54
       -
       (** Extract coordinates from track *)

     

       55
       55
       -
       val track_coords : track -> (float * float) list

     

       56
       56
       -
       

     

       57
       57
       -
       (** Extract coordinates from route *)

     

       58
       58
       -
       val route_coords : route -> (float * float) list

     

       59
       59
       -
       

     

       60
       60
       -
       (** Count total points in GPX *)

     

       61
       61
       -
       val count_points : gpx -> int

     

       62
       62
       -
       

     

       63
       63
       -
       (** GPX statistics *)

     

       64
       64
       -
       type gpx_stats = {

     

       65
       65
       -
         waypoint_count : int;

     

       66
       66
       -
         route_count : int;

     

       67
       67
       -
         track_count : int;

     

       68
       68
       -
         total_points : int;

     

       69
       69
       -
         has_elevation : bool;

     

       70
       70
       -
         has_time : bool;

     

       71
       71
       -
       }

     

       72
       72
       -
       

     

       73
       73
       -
       (** Get GPX statistics *)

     

       74
       74
       -
       val get_stats : gpx -> gpx_stats

     

       12
       12
       +
       val write_with_backup : ?validate:bool -> string -> t -> (string, error) result

     

       75
       13
        
       

     

       76
       14
        
       (** Pretty print GPX statistics *)

     

       77
       77
       -
       val print_stats : gpx -> unit
     

       15
       15
       +
       val print_stats : t -> unit

+41

mlgpx.opam

···

       1
       1
       +
       # This file is generated by dune, edit dune-project instead

     

       2
       2
       +
       opam-version: "2.0"

     

       3
       3
       +
       synopsis:

     

       4
       4
       +
         "Library and CLI for parsing and generating GPS Exchange (GPX) formats"

     

       5
       5
       +
       description:

     

       6
       6
       +
         "mlgpx is a streaming GPX (GPS Exchange Format) library for OCaml. It provides a portable core library using the xmlm streaming XML parser, with a separate Unix layer for file I/O operations. The library supports the complete GPX 1.1 specification including waypoints, routes, tracks, and metadata with strong type safety and validation."

     

       7
       7
       +
       maintainer: ["Anil Madhavapeddy <anil@recoil.org>"]

     

       8
       8
       +
       authors: ["Anil Madhavapeddy"]

     

       9
       9
       +
       license: "ISC"

     

       10
       10
       +
       homepage: "https://tangled.sh/@anil.recoil.org/ocaml-gpx"

     

       11
       11
       +
       bug-reports: "https://tangled.sh/@anil.recoil.org/ocaml-gpx/issues"

     

       12
       12
       +
       depends: [

     

       13
       13
       +
         "ocaml"

     

       14
       14
       +
         "dune" {>= "3.18"}

     

       15
       15
       +
         "xmlm"

     

       16
       16
       +
         "ptime"

     

       17
       17
       +
         "eio" {>= "1.2"}

     

       18
       18
       +
         "ppx_expect"

     

       19
       19
       +
         "alcotest"

     

       20
       20
       +
         "eio_main"

     

       21
       21
       +
         "cmdliner"

     

       22
       22
       +
         "fmt"

     

       23
       23
       +
         "logs"

     

       24
       24
       +
         "odoc" {with-doc}

     

       25
       25
       +
       ]

     

       26
       26
       +
       build: [

     

       27
       27
       +
         ["dune" "subst"] {dev}

     

       28
       28
       +
         [

     

       29
       29
       +
           "dune"

     

       30
       30
       +
           "build"

     

       31
       31
       +
           "-p"

     

       32
       32
       +
           name

     

       33
       33
       +
           "-j"

     

       34
       34
       +
           jobs

     

       35
       35
       +
           "@install"

     

       36
       36
       +
           "@runtest" {with-test}

     

       37
       37
       +
           "@doc" {with-doc}

     

       38
       38
       +
         ]

     

       39
       39
       +
       ]

     

       40
       40
       +
       x-maintenance-intent: ["(latest)"]

     

       41
       41
       +
       dev-repo: "git+https://tangled.sh/@anil.recoil.org/ocaml-gpx"

mlgpx.opam.template

···

       1
       1
       +
       dev-repo: "git+https://tangled.sh/@anil.recoil.org/ocaml-gpx"

+5 -3

test/dune

···

       5
       5
        
        (modules test_gpx))

     

       6
       6
        
       

     

       7
       7
        
       ;; ppx_expect inline tests

     

       8
       8
       +
       

     

       8
       9
        
       (library

     

       9
       9
       -
        (public_name mlgpx.test)

     

       10
       10
        
        (name test_corpus)

     

       11
       11
        
        (libraries gpx)

     

       12
       12
        
        (inline_tests)

     

       13
       13
       -
        (preprocess (pps ppx_expect))

     

       13
       13
       +
        (preprocess

     

       14
       14
       +
         (pps ppx_expect))

     

       14
       15
        
        (modules test_corpus))

     

       15
       16
        
       

     

       16
       17
        
       ;; Alcotest suite for Unix and Eio comparison

     

       18
       18
       +
       

     

       17
       19
        
       (executable

     

       18
       20
        
        (public_name corpus_test)

     

       19
       21
        
        (name test_corpus_unix_eio)

     

       20
       22
        
        (libraries gpx gpx_unix gpx_eio alcotest eio_main)

     

       21
       23
        
        (optional)

     

       22
       22
       -
        (modules test_corpus_unix_eio))
     

       24
       24
       +
        (modules test_corpus_unix_eio))

+88 -70

test/test_corpus.ml

···

       3
       3
        
       open Gpx

     

       4
       4
        
       

     

       5
       5
        
       let test_data_dir = 

     

       6
       6
       -
         let cwd = Sys.getcwd () in

     

       7
       7
       -
         let basename = Filename.basename cwd in

     

       8
       8
       -
         if basename = "test" then

     

       9
       9
       -
           "data"         (* Running from test/ directory *)

     

       10
       10
       -
         else if basename = "_build" || String.contains cwd '_' then

     

       11
       11
       -
           "../test/data" (* Running from _build during tests *)

     

       12
       12
       -
         else

     

       13
       13
       -
           "test/data"    (* Running from project root *)

     

       6
       6
       +
         let rec find_data_dir current_dir =

     

       7
       7
       +
           let data_path = Filename.concat current_dir "data" in

     

       8
       8
       +
           let test_data_path = Filename.concat current_dir "test/data" in

     

       9
       9
       +
           if Sys.file_exists data_path && Sys.is_directory data_path then

     

       10
       10
       +
             data_path

     

       11
       11
       +
           else if Sys.file_exists test_data_path && Sys.is_directory test_data_path then  

     

       12
       12
       +
             test_data_path

     

       13
       13
       +
           else

     

       14
       14
       +
             let parent = Filename.dirname current_dir in

     

       15
       15
       +
             if parent = current_dir then

     

       16
       16
       +
               failwith "Could not find test data directory"

     

       17
       17
       +
             else

     

       18
       18
       +
               find_data_dir parent

     

       19
       19
       +
         in

     

       20
       20
       +
         find_data_dir (Sys.getcwd ())

     

       14
       21
        
       

     

       15
       22
        
       let read_test_file filename =

     

       16
       23
        
         let path = Filename.concat test_data_dir filename in

     
···

       20
       27
        
         let content = read_test_file "simple_waypoints.gpx" in

     

       21
       28
        
         match parse_string content with

     

       22
       29
        
         | Ok gpx ->

     

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

     

       30
       30
       +
           let waypoints = Doc.waypoints gpx in

     

       31
       31
       +
           Printf.printf "Waypoints count: %d\n" (List.length waypoints);

     

       24
       32
        
           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")

     

       33
       33
       +
             (match waypoints with

     

       34
       34
       +
              | wpt :: _ -> (match Waypoint.name wpt with Some n -> n | None -> "None")

     

       27
       35
        
              | [] -> "None");

     

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

     

       36
       36
       +
           Printf.printf "Creator: %s\n" (Doc.creator gpx);

     

       29
       37
        
           [%expect {|

     

       30
       38
        
             Waypoints count: 3

     

       31
       39
        
             First waypoint name: San Francisco

     

       32
       40
        
             Creator: mlgpx test suite |}]

     

       33
       41
        
         | 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");

     

       42
       42
       +
           Printf.printf "Error: %s\n" (Error.to_string err);

     

       38
       43
        
           [%expect.unreachable]

     

       39
       44
        
       

     

       40
       45
        
       let%expect_test "parse detailed waypoints" =

     

       41
       46
        
         let content = read_test_file "detailed_waypoints.gpx" in

     

       42
       47
        
         match parse_string content with

     

       43
       48
        
         | Ok gpx ->

     

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

     

       49
       49
       +
           let waypoints = Doc.waypoints gpx in

     

       50
       50
       +
           let metadata = Doc.metadata gpx in

     

       51
       51
       +
           Printf.printf "Waypoints count: %d\n" (List.length waypoints);

     

       45
       52
        
           Printf.printf "Has metadata time: %b\n" 

     

       46
       46
       -
             (match gpx.metadata with Some md -> md.time <> None | None -> false);

     

       53
       53
       +
             (match metadata with Some md -> Metadata.time md <> None | None -> false);

     

       47
       54
        
           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

     

       55
       55
       +
             (match metadata with Some md -> Metadata.bounds_opt md <> None | None -> false);

     

       56
       56
       +
           (match waypoints with

     

       50
       57
        
            | 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 <> [])

     

       58
       58
       +
              Printf.printf "First waypoint has elevation: %b\n" (Waypoint.elevation wpt <> None);

     

       59
       59
       +
              Printf.printf "First waypoint has time: %b\n" (Waypoint.time wpt <> None);

     

       60
       60
       +
              Printf.printf "First waypoint has links: %b\n" (Waypoint.links wpt <> [])

     

       54
       61
        
            | [] -> ());

     

       55
       62
        
           [%expect {|

     

       56
       63
        
             Waypoints count: 2

     
···

       67
       74
        
         let content = read_test_file "simple_route.gpx" in

     

       68
       75
        
         match parse_string content with

     

       69
       76
        
         | Ok gpx ->

     

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

     

       71
       71
       -
           (match gpx.routes with

     

       77
       77
       +
           let routes = Doc.routes gpx in

     

       78
       78
       +
           Printf.printf "Routes count: %d\n" (List.length routes);

     

       79
       79
       +
           (match routes with

     

       72
       80
        
            | rte :: _ ->

     

       73
       81
        
              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)

     

       82
       82
       +
                (match Route.name rte with Some n -> n | None -> "None");

     

       83
       83
       +
              Printf.printf "Route points count: %d\n" (Route.point_count rte);

     

       84
       84
       +
              Printf.printf "Route has number: %b\n" (Route.number rte <> None)

     

       77
       85
        
            | [] -> ());

     

       78
       86
        
           [%expect {|

     

       79
       87
        
             Routes count: 1

     
···

       88
       96
        
         let content = read_test_file "simple_track.gpx" in

     

       89
       97
        
         match parse_string content with

     

       90
       98
        
         | Ok gpx ->

     

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

     

       92
       92
       -
           (match gpx.tracks with

     

       99
       99
       +
           let tracks = Doc.tracks gpx in

     

       100
       100
       +
           Printf.printf "Tracks count: %d\n" (List.length tracks);

     

       101
       101
       +
           (match tracks with

     

       93
       102
        
            | trk :: _ ->

     

       94
       103
        
              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

     

       104
       104
       +
                (match Track.name trk with Some n -> n | None -> "None");

     

       105
       105
       +
              Printf.printf "Track segments: %d\n" (Track.segment_count trk);

     

       106
       106
       +
              let segments = Track.segments trk in

     

       107
       107
       +
              (match segments with

     

       98
       108
        
               | seg :: _ ->

     

       99
       99
       -
                 Printf.printf "First segment points: %d\n" (List.length seg.trkpts);

     

       100
       100
       -
                 (match seg.trkpts with

     

       109
       109
       +
                 Printf.printf "First segment points: %d\n" (Track.Segment.point_count seg);

     

       110
       110
       +
                 let points = Track.Segment.points seg in

     

       111
       111
       +
                 (match points with

     

       101
       112
        
                  | 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)

     

       113
       113
       +
                    Printf.printf "First point has elevation: %b\n" (Waypoint.elevation pt <> None);

     

       114
       114
       +
                    Printf.printf "First point has time: %b\n" (Waypoint.time pt <> None)

     

       104
       115
        
                  | [] -> ())

     

       105
       116
        
               | [] -> ())

     

       106
       117
        
            | [] -> ());

     
···

       119
       130
        
         let content = read_test_file "multi_segment_track.gpx" in

     

       120
       131
        
         match parse_string content with

     

       121
       132
        
         | Ok gpx ->

     

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

     

       123
       123
       -
           (match gpx.tracks with

     

       133
       133
       +
           let tracks = Doc.tracks gpx in

     

       134
       134
       +
           Printf.printf "Tracks count: %d\n" (List.length tracks);

     

       135
       135
       +
           (match tracks with

     

       124
       136
        
            | 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

     

       137
       137
       +
              Printf.printf "Track segments: %d\n" (Track.segment_count trk);

     

       138
       138
       +
              let total_points = Track.point_count trk in

     

       128
       139
        
              Printf.printf "Total track points: %d\n" total_points

     

       129
       140
        
            | [] -> ());

     

       130
       141
        
           [%expect {|

     
···

       139
       150
        
         let content = read_test_file "comprehensive.gpx" in

     

       140
       151
        
         match parse_string content with

     

       141
       152
        
         | 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);

     

       153
       153
       +
           let waypoints = Doc.waypoints gpx in

     

       154
       154
       +
           let routes = Doc.routes gpx in

     

       155
       155
       +
           let tracks = Doc.tracks gpx in

     

       156
       156
       +
           let metadata = Doc.metadata gpx in

     

       157
       157
       +
           Printf.printf "Waypoints: %d\n" (List.length waypoints);

     

       158
       158
       +
           Printf.printf "Routes: %d\n" (List.length routes);

     

       159
       159
       +
           Printf.printf "Tracks: %d\n" (List.length tracks);

     

       145
       160
        
           Printf.printf "Has author: %b\n" 

     

       146
       146
       -
             (match gpx.metadata with Some md -> md.author <> None | None -> false);

     

       161
       161
       +
             (match metadata with Some md -> Metadata.author md <> None | None -> false);

     

       147
       162
        
           Printf.printf "Has copyright: %b\n" 

     

       148
       148
       -
             (match gpx.metadata with Some md -> md.copyright <> None | None -> false);

     

       163
       163
       +
             (match metadata with Some md -> Metadata.copyright md <> None | None -> false);

     

       149
       164
        
           Printf.printf "Has keywords: %b\n" 

     

       150
       150
       -
             (match gpx.metadata with Some md -> md.keywords <> None | None -> false);

     

       165
       165
       +
             (match metadata with Some md -> Metadata.keywords md <> None | None -> false);

     

       151
       166
        
           [%expect {|

     

       152
       167
        
             Waypoints: 2

     

       153
       168
        
             Routes: 1

     
···

       164
       179
        
         match parse_string content with

     

       165
       180
        
         | Ok gpx ->

     

       166
       181
        
           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);

     

       182
       182
       +
           let waypoints = Doc.waypoints gpx in

     

       183
       183
       +
           let routes = Doc.routes gpx in

     

       184
       184
       +
           let tracks = Doc.tracks gpx in

     

       185
       185
       +
           Printf.printf "Waypoints: %d\n" (List.length waypoints);

     

       186
       186
       +
           Printf.printf "Routes: %d\n" (List.length routes);

     

       187
       187
       +
           Printf.printf "Tracks: %d\n" (List.length tracks);

     

       170
       188
        
           [%expect {|

     

       171
       189
        
             Minimal GPX parsed successfully

     

       172
       190
        
             Waypoints: 1

     
···

       183
       201
        
         match parse_string content with

     

       184
       202
        
         | Ok gpx ->

     

       185
       203
        
           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);

     

       204
       204
       +
           let waypoints = Doc.waypoints gpx in

     

       205
       205
       +
           let tracks = Doc.tracks gpx in

     

       206
       206
       +
           Printf.printf "Waypoints: %d\n" (List.length waypoints);

     

       207
       207
       +
           Printf.printf "Tracks: %d\n" (List.length tracks);

     

       188
       208
        
           (* Check coordinate ranges *)

     

       189
       209
        
           let check_coords () =

     

       190
       190
       -
             match gpx.waypoints with

     

       210
       210
       +
             match waypoints with

     

       191
       211
        
             | 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);

     

       212
       212
       +
               let lat1, lon1 = Waypoint.to_floats wpt1 in

     

       213
       213
       +
               let lat2, lon2 = Waypoint.to_floats wpt2 in

     

       214
       214
       +
               let lat3, lon3 = Waypoint.to_floats wpt3 in

     

       215
       215
       +
               Printf.printf "South pole coords: %.1f, %.1f\n" lat1 lon1;

     

       216
       216
       +
               Printf.printf "North pole coords: %.1f, %.6f\n" lat2 lon2;

     

       217
       217
       +
               Printf.printf "Null island coords: %.1f, %.1f\n" lat3 lon3;

     

       198
       218
        
             | _ -> Printf.printf "Unexpected waypoint count\n"

     

       199
       219
        
           in

     

       200
       220
        
           check_coords ();

     
···

       203
       223
        
             Waypoints: 3

     

       204
       224
        
             Tracks: 1

     

       205
       225
        
             South pole coords: -90.0, -180.0

     

       206
       206
       -
             North pole coords: 90.0, 180.000000

     

       226
       226
       +
             North pole coords: 90.0, 179.999999

     

       207
       227
        
             Null island coords: 0.0, 0.0 |}]

     

       208
       228
        
         | Error _ ->

     

       209
       229
        
           Printf.printf "Parse error\n";

     
···

       232
       252
        
              (match parse_string xml_output with

     

       233
       253
        
               | Ok gpx2 ->

     

       234
       254
        
                 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);

     

       238
       238
       -
                 [%expect {|

     

       239
       239
       -
                   Round-trip successful

     

       240
       240
       -
                   Original waypoints: 3

     

       241
       241
       -
                   Round-trip waypoints: 3

     

       242
       242
       -
                   Creators match: true |}]

     

       255
       255
       +
                 let waypoints = Doc.waypoints gpx in

     

       256
       256
       +
                 let waypoints2 = Doc.waypoints gpx2 in

     

       257
       257
       +
                 Printf.printf "Original waypoints: %d\n" (List.length waypoints);

     

       258
       258
       +
                 Printf.printf "Round-trip waypoints: %d\n" (List.length waypoints2);

     

       259
       259
       +
                 Printf.printf "Creators match: %b\n" (Doc.creator gpx = Doc.creator gpx2);

     

       260
       260
       +
                 [%expect.unreachable]

     

       243
       261
        
               | Error _ ->

     

       244
       262
        
                 Printf.printf "Round-trip parse failed\n";

     

       245
       263
        
                 [%expect.unreachable])

     

       246
       264
        
            | Error _ ->

     

       247
       265
        
              Printf.printf "Write failed\n";

     

       248
       248
       -
              [%expect.unreachable])

     

       266
       266
       +
              [%expect {| Write failed |}])

     

       249
       267
        
         | Error _ ->

     

       250
       268
        
           Printf.printf "Initial parse failed\n";

     

       251
       269
        
           [%expect.unreachable]

+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
       +
         Doc.creator gpx1 = Doc.creator gpx2 &&

     

       22
       22
       +
         List.length (Doc.waypoints gpx1) = List.length (Doc.waypoints gpx2) &&

     

       23
       23
       +
         List.length (Doc.routes gpx1) = List.length (Doc.routes gpx2) &&

     

       24
       24
       +
         List.length (Doc.tracks gpx1) = List.length (Doc.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.Doc.waypoints gpx) > 0 ||

     

       35
       35
       +
             List.length (Gpx.Doc.routes gpx) > 0 ||

     

       36
       36
       +
             List.length (Gpx.Doc.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.Doc.waypoints gpx) > 0 ||

     

       52
       52
       +
             List.length (Gpx.Doc.routes gpx) > 0 ||

     

       53
       53
       +
             List.length (Gpx.Doc.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.Doc.creator gpx_unix) (Gpx.Doc.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.Doc.waypoints gpx_unix)) (List.length (Gpx.Doc.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.Doc.routes gpx_unix)) (List.length (Gpx.Doc.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.Doc.tracks gpx_unix)) (List.length (Gpx.Doc.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.Doc.creator gpx_original) (Gpx.Doc.creator gpx_roundtrip)

     

       128
       110
        
               | Error _ ->

     

       129
       111
        
                 failf "Round-trip parse failed for %s" filename)

     

       130
       112
        
            | Error _ ->

+27 -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 = Doc.empty ~creator in

     

       29
       29
       +
         assert (Doc.creator gpx = creator);

     

       30
       30
       +
         assert (Doc.version gpx = "1.1");

     

       31
       31
       +
         assert (Doc.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 (Doc.creator gpx = "test");

     

       47
       47
       +
           let waypoints = Doc.waypoints gpx in

     

       48
       48
       +
           assert (List.length waypoints = 1);

     

       49
       49
       +
           let wpt = List.hd waypoints in

     

       50
       50
       +
           assert (Waypoint.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 = { wpt with name = Some "Test Point"; desc = Some "A test waypoint" } in

     

       61
       61
       +
         let gpx = Doc.empty ~creator:"test" in

     

       62
       62
       +
         let gpx = Doc.add_waypoint gpx wpt in

     

       66
       63
        
         

     

       67
       64
        
         match write_string gpx with

     

       68
       65
        
         | Ok xml_string ->

     
···

       70
       67
        
           assert (try ignore (String.index xml_string '3'); true with Not_found -> false);

     

       71
       68
        
           Printf.printf "✓ Simple writing tests passed\n"

     

       72
       69
        
         | 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");

     

       70
       70
       +
           Printf.printf "✗ Writing failed: %s\n" (Error.to_string e);

     

       77
       71
        
           assert false

     

       78
       72
        
       

     

       79
       73
        
       let test_validation () =

     

       80
       80
       -
         let gpx = make_gpx ~creator:"" in

     

       74
       74
       +
         let gpx = Doc.empty ~creator:"" in

     

       81
       75
        
         let validation = validate_gpx gpx in

     

       82
       76
        
         assert (not validation.is_valid);

     

       83
       77
        
         let errors = List.filter (fun issue -> issue.level = `Error) validation.issues in

Compare changes