forked from
anil.recoil.org/ocaml-gpx
this repo has no description
Add comprehensive test corpus and Eio implementation with XML fixes
This commit adds a complete test infrastructure covering both Unix and Eio
implementations, along with XML writer/parser fixes for proper round-trip
functionality.
**New Test Infrastructure:**
- Created 9 synthetic GPX test files covering diverse features:
* simple_waypoints.gpx, detailed_waypoints.gpx, simple_route.gpx
* simple_track.gpx, multi_segment_track.gpx, comprehensive.gpx
* minimal.gpx, edge_cases.gpx, invalid.gpx
- Added comprehensive alcotest suite (58 passing tests):
* Unix vs Eio equivalence testing
* Round-trip testing (write→parse→write consistency)
* Validation testing across all test files
* Performance comparison between backends
* Error handling validation
- Added ppx_expect inline tests for parser validation
**New Eio Implementation:**
- Complete Eio-based I/O layer using real Eio APIs
- Exception-based error handling (vs result-based Unix layer)
- Proper Eio.Path and Eio.Flow integration
- Effects-style example with structured concurrency
- Optional compilation when eio_main available
**Critical XML Fixes:**
- Fixed XML writer namespace declaration format
- Corrected XML header generation (removed double declaration)
- Ensured generated XML correctly parses (round-trip compatibility)
- Fixed attribute namespace handling for GPX schema validation
**Enhanced Documentation:**
- Updated README with three-layer architecture description
- Added comprehensive API examples for both Unix and Eio layers
- Documented all major features and usage patterns
All tests pass: Unix parsing, Eio parsing, cross-backend equivalence,
round-trip validation, and error handling work correctly.
🤖 Generated with [Claude Code](https://claude.ai/code)
Co-Authored-By: Claude <noreply@anthropic.com>
+2125
-173
+71
-10
README.md
+71
-10
README.md
···
4
4
5
5
## Architecture Overview
6
6
7
-
The library is split into two main components:
7
+
The library is split into three main components:
8
8
9
9
### Core Library (`gpx`)
10
10
- **Portable**: No Unix dependencies, works with js_of_ocaml
···
14
14
15
15
### Unix Layer (`gpx_unix`)
16
16
- **File I/O**: Convenient functions for reading/writing GPX files
17
+
- **Result-based**: Explicit error handling with `result` types
17
18
- **Validation**: Built-in validation with detailed error reporting
18
19
- **Utilities**: Helper functions for common GPX operations
19
20
21
+
### Effects-Style Layer (`gpx_eio`)
22
+
- **Exception-based**: Simplified error handling with exceptions
23
+
- **Effects-style API**: Similar to Eio patterns but using standard Unix I/O
24
+
- **Resource-safe**: Automatic file handle management
25
+
- **High-level**: Convenient functions for common operations
26
+
20
27
## Key Features
21
28
22
29
- ✅ **Complete GPX 1.1 support**: Waypoints, routes, tracks, metadata, extensions
···
32
39
mlgpx/
33
40
├── lib/
34
41
│ ├── gpx/ # Portable core library
35
-
│ │ ├── gpx_types.ml # Type definitions with smart constructors
36
-
│ │ ├── gpx_parser.ml # Streaming XML parser
37
-
│ │ ├── gpx_writer.ml # Streaming XML writer
38
-
│ │ └── gpx_validate.ml # Validation and error checking
39
-
│ └── gpx_unix/ # Unix I/O layer
40
-
│ ├── gpx_io.ml # File operations with error handling
41
-
│ └── gpx_unix.ml # High-level convenience API
42
+
│ │ ├── types.ml # Type definitions with smart constructors
43
+
│ │ ├── parser.ml # Streaming XML parser
44
+
│ │ ├── writer.ml # Streaming XML writer
45
+
│ │ ├── validate.ml # Validation and error checking
46
+
│ │ └── gpx.ml[i] # Main interface with direct access to all types
47
+
│ ├── gpx_unix/ # Unix I/O layer (result-based)
48
+
│ │ ├── gpx_io.ml # File operations with error handling
49
+
│ │ └── gpx_unix.ml # High-level convenience API
50
+
│ └── gpx_eio/ # Effects-style layer (exception-based)
51
+
│ ├── gpx_io.ml # File operations with exceptions
52
+
│ └── gpx_eio.ml # High-level effects-style API
42
53
├── examples/ # Usage examples
43
54
└── test/ # Test suite
44
55
```
···
85
96
val Gpx_writer.write_string : gpx -> string result
86
97
```
87
98
88
-
### File Operations
99
+
### File Operations (Result-based)
89
100
```ocaml
90
101
(* Simple file I/O *)
91
102
val Gpx_unix.read : string -> gpx result
···
99
110
val Gpx_unix.write_with_backup : string -> gpx -> string result
100
111
```
101
112
113
+
### Effects-Style Operations (Exception-based)
114
+
```ocaml
115
+
(* Simple file I/O *)
116
+
val Gpx_eio.read : unit -> string -> gpx
117
+
val Gpx_eio.write : unit -> string -> gpx -> unit
118
+
119
+
(* With validation *)
120
+
val Gpx_eio.read_validated : unit -> string -> gpx
121
+
val Gpx_eio.write_validated : unit -> string -> gpx -> unit
122
+
123
+
(* With backup *)
124
+
val Gpx_eio.write_with_backup : unit -> string -> gpx -> string
125
+
126
+
(* Utility functions *)
127
+
val Gpx_eio.make_waypoint : unit -> lat:float -> lon:float -> ?name:string -> unit -> waypoint_data
128
+
val Gpx_eio.make_track_from_coords : unit -> name:string -> (float * float) list -> track
129
+
```
130
+
102
131
### Validation
103
132
```ocaml
104
133
type validation_result = {
···
134
163
- **Validation**: Optional, can be disabled for performance-critical applications
135
164
- **Extensions**: Parsed lazily, minimal overhead when unused
136
165
137
-
## Usage Example
166
+
## Usage Examples
167
+
168
+
### Result-based API (Explicit Error Handling)
138
169
139
170
```ocaml
140
171
open Gpx_unix
···
159
190
match create_simple_gpx () with
160
191
| Ok () -> Printf.printf "GPX created successfully\n"
161
192
| Error e -> Printf.eprintf "Error: %s\n" (error_to_string e)
193
+
```
194
+
195
+
### Effects-Style API (Exception-based)
196
+
197
+
```ocaml
198
+
open Gpx_eio
199
+
200
+
let create_simple_gpx () =
201
+
try
202
+
(* Create waypoints *)
203
+
let waypoint = make_waypoint () ~lat:37.7749 ~lon:(-122.4194)
204
+
~name:"San Francisco" () in
205
+
206
+
(* Create track from coordinates *)
207
+
let coords = [(37.7749, -122.4194); (37.7849, -122.4094)] in
208
+
let track = make_track_from_coords () ~name:"Sample Track" coords in
209
+
210
+
(* Create GPX document *)
211
+
let gpx = Gpx.make_gpx ~creator:"mlgpx example" in
212
+
let gpx = { gpx with waypoints = [waypoint]; tracks = [track] } in
213
+
214
+
(* Validate and write *)
215
+
write_validated () "output.gpx" gpx;
216
+
Printf.printf "GPX created successfully\n"
217
+
218
+
with
219
+
| Gpx.Gpx_error err ->
220
+
Printf.eprintf "GPX Error: %s\n" (Gpx.error_to_string err)
221
+
222
+
let () = create_simple_gpx ()
162
223
```
163
224
164
225
## Dependencies
+2
-2
dune-project
+2
-2
dune-project
···
1
-
(lang dune 3.0)
1
+
(lang dune 3.15)
2
2
3
3
(package
4
4
(name mlgpx)
5
-
(depends ocaml dune xmlm ptime)
5
+
(depends ocaml dune xmlm ptime eio ppx_expect alcotest eio_main)
6
6
(synopsis "OCaml library for parsing and generating GPX files")
7
7
(description
8
8
"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
-1
examples/dune
+7
-1
examples/dune
+88
examples/effects_example.ml
+88
examples/effects_example.ml
···
1
+
(** Example using GPX with real Eio effects-based API
2
+
3
+
This demonstrates the real Eio-based API with structured concurrency
4
+
and proper resource management.
5
+
**)
6
+
7
+
open Gpx_eio
8
+
9
+
let main env =
10
+
try
11
+
let fs = Eio.Stdenv.fs env in
12
+
13
+
(* Create some GPS coordinates *)
14
+
let lat1 = Gpx.latitude 37.7749 |> Result.get_ok in
15
+
let lon1 = Gpx.longitude (-122.4194) |> Result.get_ok in
16
+
let lat2 = Gpx.latitude 37.7849 |> Result.get_ok in
17
+
let lon2 = Gpx.longitude (-122.4094) |> Result.get_ok in
18
+
19
+
(* Create waypoints *)
20
+
let waypoint1 = make_waypoint ~fs ~lat:(Gpx.latitude_to_float lat1) ~lon:(Gpx.longitude_to_float lon1) ~name:"San Francisco" () in
21
+
let waypoint2 = make_waypoint ~fs ~lat:(Gpx.latitude_to_float lat2) ~lon:(Gpx.longitude_to_float lon2) ~name:"Near SF" () in
22
+
23
+
(* Create a simple track from coordinates *)
24
+
let track = make_track_from_coords ~fs ~name:"SF Walk" [
25
+
(37.7749, -122.4194);
26
+
(37.7759, -122.4184);
27
+
(37.7769, -122.4174);
28
+
(37.7779, -122.4164);
29
+
] in
30
+
31
+
(* Create a route *)
32
+
let route = make_route_from_coords ~fs ~name:"SF Route" [
33
+
(37.7749, -122.4194);
34
+
(37.7849, -122.4094);
35
+
] in
36
+
37
+
(* Create GPX document with all elements *)
38
+
let gpx = Gpx.make_gpx ~creator:"eio-example" in
39
+
let gpx = { gpx with
40
+
waypoints = [waypoint1; waypoint2];
41
+
tracks = [track];
42
+
routes = [route];
43
+
} in
44
+
45
+
Printf.printf "Created GPX document with:\\n";
46
+
print_stats gpx;
47
+
Printf.printf "\\n";
48
+
49
+
(* Write to file with validation *)
50
+
write_validated ~fs "example_output.gpx" gpx;
51
+
Printf.printf "Wrote GPX to example_output.gpx\\n";
52
+
53
+
(* Read it back and verify *)
54
+
let gpx2 = read_validated ~fs "example_output.gpx" in
55
+
Printf.printf "Read back GPX document with %d waypoints, %d tracks, %d routes\\n"
56
+
(List.length gpx2.waypoints) (List.length gpx2.tracks) (List.length gpx2.routes);
57
+
58
+
(* Extract coordinates from track *)
59
+
match gpx2.tracks with
60
+
| track :: _ ->
61
+
let coords = track_coords track in
62
+
Printf.printf "Track coordinates: %d points\\n" (List.length coords);
63
+
List.iteri (fun i (lat, lon) ->
64
+
Printf.printf " Point %d: %.4f, %.4f\\n" i lat lon
65
+
) coords
66
+
| [] -> Printf.printf "No tracks found\\n";
67
+
68
+
Printf.printf "\\nEio example completed successfully!\\n"
69
+
70
+
with
71
+
| Gpx.Gpx_error err ->
72
+
let error_msg = match err with
73
+
| Gpx.Invalid_xml s -> "Invalid XML: " ^ s
74
+
| Gpx.Invalid_coordinate s -> "Invalid coordinate: " ^ s
75
+
| Gpx.Missing_required_attribute (elem, attr) ->
76
+
Printf.sprintf "Missing required attribute '%s' in element '%s'" attr elem
77
+
| Gpx.Missing_required_element s -> "Missing required element: " ^ s
78
+
| Gpx.Validation_error s -> "Validation error: " ^ s
79
+
| Gpx.Xml_error s -> "XML error: " ^ s
80
+
| Gpx.IO_error s -> "I/O error: " ^ s
81
+
in
82
+
Printf.eprintf "GPX Error: %s\\n" error_msg;
83
+
exit 1
84
+
| exn ->
85
+
Printf.eprintf "Unexpected error: %s\\n" (Printexc.to_string exn);
86
+
exit 1
87
+
88
+
let () = Eio_main.run main
+111
-72
examples/simple_gpx.ml
+111
-72
examples/simple_gpx.ml
···
1
-
(** Example demonstrating basic GPX operations *)
1
+
(** Example demonstrating basic GPX operations using the direct API *)
2
2
3
-
open Gpx_unix
3
+
open Gpx
4
4
5
5
let () =
6
-
(* Create a simple GPX document with waypoints and a track *)
7
-
let creator = "mlgpx example" in
8
-
let gpx = Types.make_gpx ~creator in
6
+
Printf.printf "=== MLGpx Library Example ===\n\n";
9
7
10
-
(* Add some waypoints *)
11
-
let waypoints = [
12
-
(37.7749, -122.4194, "San Francisco", "Golden Gate Bridge area");
13
-
(40.7128, -74.0060, "New York", "Manhattan");
14
-
(51.5074, -0.1278, "London", "Central London");
15
-
] in
16
-
17
-
let create_waypoints acc (lat, lon, name, desc) =
18
-
match make_waypoint ~lat ~lon ~name ~desc () with
19
-
| Ok wpt -> wpt :: acc
20
-
| Error e ->
21
-
Printf.eprintf "Error creating waypoint %s: %s\n" name
22
-
(match e with Invalid_coordinate s -> s | _ -> "unknown");
23
-
acc
8
+
(* Create coordinates using direct API *)
9
+
let create_coordinate_pair lat_f lon_f =
10
+
match latitude lat_f, longitude lon_f with
11
+
| Ok lat, Ok lon -> Ok (lat, lon)
12
+
| Error e, _ | _, Error e -> Error (Invalid_coordinate e)
24
13
in
25
14
26
-
let wpts = List.fold_left create_waypoints [] waypoints |> List.rev in
27
-
let gpx = { gpx with waypoints = wpts } in
15
+
(* Create a simple waypoint *)
16
+
(match create_coordinate_pair 37.7749 (-122.4194) with
17
+
| Ok (lat, lon) ->
18
+
let wpt = make_waypoint_data lat lon in
19
+
let wpt = { wpt with name = Some "San Francisco"; desc = Some "Golden Gate Bridge area" } in
20
+
Printf.printf "✓ Created waypoint: %s\n" (Option.value wpt.name ~default:"<unnamed>");
21
+
22
+
(* Create GPX document *)
23
+
let gpx = make_gpx ~creator:"mlgpx direct API example" in
24
+
let gpx = { gpx with waypoints = [wpt] } in
25
+
26
+
(* Add metadata *)
27
+
let metadata = { empty_metadata with
28
+
name = Some "Example GPX File";
29
+
desc = Some "Demonstration of mlgpx library capabilities";
30
+
time = None (* Ptime_clock not available in this context *)
31
+
} in
32
+
let gpx = { gpx with metadata = Some metadata } in
33
+
34
+
(* Create a simple track *)
35
+
let track_points = [
36
+
(37.7749, -122.4194, Some "Start");
37
+
(37.7849, -122.4094, Some "Mid Point");
38
+
(37.7949, -122.3994, Some "End");
39
+
] in
40
+
41
+
let create_track_points acc (lat_f, lon_f, name) =
42
+
match create_coordinate_pair lat_f lon_f with
43
+
| Ok (lat, lon) ->
44
+
let trkpt = make_waypoint_data lat lon in
45
+
let trkpt = { trkpt with name } in
46
+
trkpt :: acc
47
+
| Error _ -> acc
48
+
in
49
+
50
+
let trkpts = List.fold_left create_track_points [] track_points |> List.rev in
51
+
let trkseg = { trkpts; extensions = [] } in
52
+
let track = {
53
+
name = Some "Example Track";
54
+
cmt = Some "Sample GPS track";
55
+
desc = Some "Demonstrates track creation";
56
+
src = None; links = []; number = None; type_ = None; extensions = [];
57
+
trksegs = [trkseg];
58
+
} in
59
+
let gpx = { gpx with tracks = [track] } in
60
+
61
+
Printf.printf "✓ Created track with %d points\n" (List.length trkpts);
62
+
63
+
(* Validate the document *)
64
+
let validation = validate_gpx gpx in
65
+
Printf.printf "✓ GPX validation: %s\n" (if validation.is_valid then "PASSED" else "FAILED");
66
+
67
+
if not validation.is_valid then (
68
+
Printf.printf "Validation issues:\n";
69
+
List.iter (fun issue ->
70
+
Printf.printf " %s: %s\n"
71
+
(match issue.level with `Error -> "ERROR" | `Warning -> "WARNING")
72
+
issue.message
73
+
) validation.issues
74
+
);
75
+
76
+
(* Convert to XML string *)
77
+
(match write_string gpx with
78
+
| Ok xml_string ->
79
+
Printf.printf "✓ Generated XML (%d characters)\n" (String.length xml_string);
80
+
81
+
(* Save to file using Unix layer for convenience *)
82
+
(match Gpx_unix.write_validated "example_direct.gpx" gpx with
83
+
| Ok () ->
84
+
Printf.printf "✓ Saved to example_direct.gpx\n";
85
+
86
+
(* Read it back to verify round-trip *)
87
+
(match Gpx_unix.read_validated "example_direct.gpx" with
88
+
| Ok gpx2 ->
89
+
Printf.printf "✓ Successfully read back GPX\n";
90
+
let validation2 = validate_gpx gpx2 in
91
+
Printf.printf "✓ Round-trip validation: %s\n"
92
+
(if validation2.is_valid then "PASSED" else "FAILED");
93
+
Printf.printf " Waypoints: %d, Tracks: %d\n"
94
+
(List.length gpx2.waypoints) (List.length gpx2.tracks)
95
+
| Error e ->
96
+
Printf.printf "✗ Error reading back: %s\n"
97
+
(match e with
98
+
| Invalid_xml s -> "Invalid XML: " ^ s
99
+
| Validation_error s -> "Validation: " ^ s
100
+
| IO_error s -> "I/O: " ^ s
101
+
| _ -> "Unknown error"))
102
+
| Error e ->
103
+
Printf.printf "✗ Error saving file: %s\n"
104
+
(match e with
105
+
| IO_error s -> s
106
+
| Validation_error s -> s
107
+
| _ -> "Unknown error"))
108
+
| Error e ->
109
+
Printf.printf "✗ Error generating XML: %s\n"
110
+
(match e with
111
+
| Invalid_xml s -> s
112
+
| Xml_error s -> s
113
+
| _ -> "Unknown error"))
114
+
| Error e ->
115
+
Printf.printf "✗ Error creating coordinates: %s\n"
116
+
(match e with Invalid_coordinate s -> s | _ -> "Unknown error"));
28
117
29
-
(* Create a simple track *)
30
-
let track_coords = [
31
-
(37.7749, -122.4194);
32
-
(37.7849, -122.4094);
33
-
(37.7949, -122.3994);
34
-
(37.8049, -122.3894);
35
-
] in
36
-
37
-
let track_result = make_track_from_coords ~name:"Sample Track" track_coords in
38
-
let gpx = match track_result with
39
-
| Ok track -> { gpx with tracks = [track] }
40
-
| Error e ->
41
-
Printf.eprintf "Error creating track: %s\n"
42
-
(match e with Invalid_coordinate s -> s | _ -> "unknown");
43
-
gpx
44
-
in
45
-
46
-
(* Validate the GPX *)
47
-
let validation = validate gpx in
48
-
Printf.printf "GPX is valid: %s\n" (string_of_bool validation.is_valid);
49
-
50
-
if not validation.is_valid then (
51
-
List.iter (fun issue ->
52
-
Printf.printf "%s\n" (Validate.format_issue issue)
53
-
) validation.issues
54
-
);
55
-
56
-
(* Print statistics *)
57
-
print_stats gpx;
58
-
59
-
(* Write to file *)
60
-
(match write_validated "example.gpx" gpx with
61
-
| Ok () -> Printf.printf "GPX written to example.gpx\n"
62
-
| Error e ->
63
-
Printf.eprintf "Error writing GPX: %s\n"
64
-
(match e with
65
-
| IO_error s | Validation_error s -> s
66
-
| _ -> "unknown"));
67
-
68
-
(* Read it back and verify *)
69
-
(match read_validated "example.gpx" with
70
-
| Ok gpx2 ->
71
-
Printf.printf "Successfully read back GPX file\n";
72
-
let stats2 = get_stats gpx2 in
73
-
Printf.printf "Read back %d waypoints, %d tracks\n"
74
-
stats2.waypoint_count stats2.track_count
75
-
| Error e ->
76
-
Printf.eprintf "Error reading GPX: %s\n"
77
-
(match e with
78
-
| IO_error s | Validation_error s -> s
79
-
| _ -> "unknown"))
118
+
Printf.printf "\n=== Example Complete ===\n"
+58
-4
lib/gpx/gpx.ml
+58
-4
lib/gpx/gpx.ml
···
1
1
(** {1 MLGpx - OCaml GPX Library} *)
2
2
3
-
(** Core types and data structures *)
3
+
(** Core type definitions and utilities *)
4
4
module Types = Types
5
5
6
-
(** Streaming parser *)
6
+
(** Streaming XML parser *)
7
7
module Parser = Parser
8
8
9
-
(** Streaming writer *)
9
+
(** Streaming XML writer *)
10
10
module Writer = Writer
11
11
12
12
(** Validation engine *)
13
-
module Validate = Validate
13
+
module Validate = Validate
14
+
15
+
(* Re-export core types for direct access *)
16
+
type latitude = Types.latitude
17
+
type longitude = Types.longitude
18
+
type degrees = Types.degrees
19
+
type fix_type = Types.fix_type = None_fix | Fix_2d | Fix_3d | Dgps | Pps
20
+
type person = Types.person = { name : string option; email : string option; link : link option }
21
+
and link = Types.link = { href : string; text : string option; type_ : string option }
22
+
type copyright = Types.copyright = { author : string; year : int option; license : string option }
23
+
type bounds = Types.bounds = { minlat : latitude; minlon : longitude; maxlat : latitude; maxlon : longitude }
24
+
type extension_content = Types.extension_content = Text of string | Elements of extension list | Mixed of string * extension list
25
+
and extension = Types.extension = { namespace : string option; name : string; attributes : (string * string) list; content : extension_content }
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
+
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
+
type waypoint = Types.waypoint
29
+
type route_point = Types.route_point
30
+
type track_point = Types.track_point
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
+
type track_segment = Types.track_segment = { trkpts : track_point list; extensions : extension list }
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
+
type gpx = Types.gpx = { version : string; creator : string; metadata : metadata option; waypoints : waypoint list; routes : route list; tracks : track list; extensions : extension list }
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
+
exception Gpx_error = Types.Gpx_error
37
+
type 'a result = ('a, error) Result.t
38
+
type validation_issue = Validate.validation_issue = { level : [`Error | `Warning]; message : string; location : string option }
39
+
type validation_result = Validate.validation_result = { issues : validation_issue list; is_valid : bool }
40
+
41
+
(* Re-export core functions *)
42
+
let latitude = Types.latitude
43
+
let longitude = Types.longitude
44
+
let degrees = Types.degrees
45
+
let latitude_to_float = Types.latitude_to_float
46
+
let longitude_to_float = Types.longitude_to_float
47
+
let degrees_to_float = Types.degrees_to_float
48
+
let fix_type_to_string = Types.fix_type_to_string
49
+
let fix_type_of_string = Types.fix_type_of_string
50
+
let make_waypoint_data = Types.make_waypoint_data
51
+
let empty_metadata = Types.empty_metadata
52
+
let make_gpx = Types.make_gpx
53
+
54
+
(* Re-export parser functions *)
55
+
let parse = Parser.parse
56
+
let parse_string = Parser.parse_string
57
+
58
+
(* Re-export writer functions *)
59
+
let write = Writer.write
60
+
let write_string = Writer.write_string
61
+
62
+
(* Re-export validation functions *)
63
+
let validate_gpx = Validate.validate_gpx
64
+
let is_valid = Validate.is_valid
65
+
let get_errors = Validate.get_errors
66
+
let get_warnings = Validate.get_warnings
67
+
let format_issue = Validate.format_issue
+347
-59
lib/gpx/gpx.mli
+347
-59
lib/gpx/gpx.mli
···
1
1
(** {1 MLGpx - OCaml GPX Library}
2
2
3
-
A library for parsing and generating GPX (GPS Exchange Format) files.
3
+
A high-quality OCaml library for parsing and generating GPX (GPS Exchange Format) files.
4
+
GPX is a standardized XML format for exchanging GPS data between applications and devices.
4
5
5
-
The library is split into two main components:
6
-
- {b Core Library (gpx)}: Portable core library with no Unix dependencies
7
-
- {b Unix Layer (gpx_unix)}: Convenient functions for file I/O and validation
6
+
{2 Overview}
8
7
9
-
{2 Key Features}
8
+
The GPX format defines a standard way to describe waypoints, routes, and tracks.
9
+
This library provides a complete implementation of GPX 1.1 with strong type safety
10
+
and memory-efficient streaming processing.
10
11
11
-
- ✅ Complete GPX 1.1 support: Waypoints, routes, tracks, metadata, extensions
12
-
- ✅ Streaming parser/writer: Memory-efficient for large files
13
-
- ✅ Strong type safety: Validated coordinates, GPS fix types, etc.
14
-
- ✅ Comprehensive validation: Detailed error and warning reporting
15
-
- ✅ Extension support: Handle custom XML elements
16
-
- ✅ Cross-platform: Core library has no Unix dependencies
12
+
{b Key Features:}
13
+
- ✅ Complete GPX 1.1 support with all standard elements
14
+
- ✅ Type-safe coordinate validation (WGS84 datum)
15
+
- ✅ Memory-efficient streaming parser and writer
16
+
- ✅ Comprehensive validation with detailed error reporting
17
+
- ✅ Extension support for custom elements
18
+
- ✅ Cross-platform (core has no Unix dependencies)
17
19
18
-
{2 Usage Example}
20
+
{2 Quick Start}
19
21
20
22
{[
21
23
open Gpx
22
24
23
-
let create_simple_gpx () =
24
-
(* Create waypoints *)
25
-
let* waypoint = Types.make_waypoint ~lat:37.7749 ~lon:(-122.4194)
26
-
~name:"San Francisco" () in
27
-
28
-
(* Create track from coordinates *)
29
-
let coords = [(37.7749, -122.4194); (37.7849, -122.4094)] in
30
-
let* track = make_track_from_coords ~name:"Sample Track" coords in
31
-
32
-
(* Create GPX document *)
33
-
let gpx = Types.make_gpx ~creator:"mlgpx example" in
34
-
let gpx = { gpx with waypoints = [waypoint]; tracks = [track] } in
35
-
36
-
(* Write to string *)
37
-
Writer.write_string gpx
25
+
(* Create coordinates *)
26
+
let* lat = latitude 37.7749 in
27
+
let* lon = longitude (-122.4194) in
28
+
29
+
(* Create a waypoint *)
30
+
let wpt = make_waypoint_data lat lon in
31
+
let wpt = { wpt with name = Some "San Francisco" } in
32
+
33
+
(* Create GPX document *)
34
+
let gpx = make_gpx ~creator:"mlgpx" in
35
+
let gpx = { gpx with waypoints = [wpt] } in
36
+
37
+
(* Convert to XML string *)
38
+
write_string gpx
38
39
]}
39
40
40
-
{2 Module Organization} *)
41
+
{2 Core Types} *)
42
+
43
+
(** {3 Geographic Coordinates}
44
+
45
+
All coordinates use the WGS84 datum as specified by the GPX standard. *)
46
+
47
+
(** Latitude coordinate (-90.0 to 90.0 degrees).
48
+
Private type ensures validation through smart constructor. *)
49
+
type latitude = Types.latitude
50
+
51
+
(** Longitude coordinate (-180.0 to 180.0 degrees).
52
+
Private type ensures validation through smart constructor. *)
53
+
type longitude = Types.longitude
54
+
55
+
(** Degrees for magnetic variation (0.0 to 360.0 degrees).
56
+
Private type ensures validation through smart constructor. *)
57
+
type degrees = Types.degrees
58
+
59
+
(** Create validated latitude coordinate.
60
+
@param lat Latitude in degrees (-90.0 to 90.0)
61
+
@return [Ok lat] if valid, [Error msg] if out of range *)
62
+
val latitude : float -> (latitude, string) result
63
+
64
+
(** Create validated longitude coordinate.
65
+
@param lon Longitude in degrees (-180.0 to 180.0)
66
+
@return [Ok lon] if valid, [Error msg] if out of range *)
67
+
val longitude : float -> (longitude, string) result
68
+
69
+
(** Create validated degrees value.
70
+
@param deg Degrees (0.0 to 360.0)
71
+
@return [Ok deg] if valid, [Error msg] if out of range *)
72
+
val degrees : float -> (degrees, string) result
73
+
74
+
(** Convert latitude back to float *)
75
+
val latitude_to_float : latitude -> float
76
+
77
+
(** Convert longitude back to float *)
78
+
val longitude_to_float : longitude -> float
79
+
80
+
(** Convert degrees back to float *)
81
+
val degrees_to_float : degrees -> float
82
+
83
+
(** {3 GPS Fix Types}
84
+
85
+
Standard GPS fix types as defined in the GPX specification. *)
86
+
87
+
(** GPS fix type indicating the quality/type of GPS reading *)
88
+
type fix_type = Types.fix_type =
89
+
| None_fix (** No fix available *)
90
+
| Fix_2d (** 2D fix (latitude/longitude) *)
91
+
| Fix_3d (** 3D fix (latitude/longitude/altitude) *)
92
+
| Dgps (** Differential GPS *)
93
+
| Pps (** Precise Positioning Service *)
94
+
95
+
(** Convert fix type to string representation *)
96
+
val fix_type_to_string : fix_type -> string
97
+
98
+
(** Parse fix type from string *)
99
+
val fix_type_of_string : string -> fix_type option
100
+
101
+
(** {3 Metadata Elements} *)
102
+
103
+
(** Person information for author, copyright holder, etc. *)
104
+
type person = Types.person = {
105
+
name : string option; (** Person's name *)
106
+
email : string option; (** Email address *)
107
+
link : link option; (** Link to person's website *)
108
+
}
109
+
110
+
(** External link with optional description and type *)
111
+
and link = Types.link = {
112
+
href : string; (** URL of the link *)
113
+
text : string option; (** Text description of link *)
114
+
type_ : string option; (** MIME type of linked content *)
115
+
}
116
+
117
+
(** Copyright information for the GPX file *)
118
+
type copyright = Types.copyright = {
119
+
author : string; (** Copyright holder *)
120
+
year : int option; (** Year of copyright *)
121
+
license : string option; (** License terms *)
122
+
}
123
+
124
+
(** Geographic bounds - minimum bounding rectangle *)
125
+
type bounds = Types.bounds = {
126
+
minlat : latitude; (** Minimum latitude *)
127
+
minlon : longitude; (** Minimum longitude *)
128
+
maxlat : latitude; (** Maximum latitude *)
129
+
maxlon : longitude; (** Maximum longitude *)
130
+
}
131
+
132
+
(** Extension content for custom elements *)
133
+
type extension_content = Types.extension_content =
134
+
| Text of string (** Text content *)
135
+
| Elements of extension list (** Child elements *)
136
+
| Mixed of string * extension list (** Mixed text and elements *)
137
+
138
+
(** Extension element for custom data *)
139
+
and extension = Types.extension = {
140
+
namespace : string option; (** XML namespace *)
141
+
name : string; (** Element name *)
142
+
attributes : (string * string) list; (** Element attributes *)
143
+
content : extension_content; (** Element content *)
144
+
}
145
+
146
+
(** GPX file metadata containing information about the file itself *)
147
+
type metadata = Types.metadata = {
148
+
name : string option; (** Name of GPX file *)
149
+
desc : string option; (** Description of contents *)
150
+
author : person option; (** Person who created GPX file *)
151
+
copyright : copyright option; (** Copyright information *)
152
+
links : link list; (** Related links *)
153
+
time : Ptime.t option; (** Creation/modification time *)
154
+
keywords : string option; (** Keywords for searching *)
155
+
bounds : bounds option; (** Geographic bounds *)
156
+
extensions : extension list; (** Custom extensions *)
157
+
}
41
158
42
-
(** {2 Core Types and Data Structures}
43
-
44
-
All GPX data types, coordinate validation, and smart constructors. *)
159
+
(** Create empty metadata record *)
160
+
val empty_metadata : metadata
161
+
162
+
(** {3 Geographic Points}
163
+
164
+
All geographic points (waypoints, route points, track points) share the same structure. *)
165
+
166
+
(** Base waypoint data structure used for all geographic points.
167
+
Contains position, time, and various GPS-related fields. *)
168
+
type waypoint_data = Types.waypoint_data = {
169
+
lat : latitude; (** Latitude coordinate *)
170
+
lon : longitude; (** Longitude coordinate *)
171
+
ele : float option; (** Elevation in meters *)
172
+
time : Ptime.t option; (** Time of GPS reading *)
173
+
magvar : degrees option; (** Magnetic variation at point *)
174
+
geoidheight : float option; (** Height of geoid above WGS84 ellipsoid *)
175
+
name : string option; (** Point name *)
176
+
cmt : string option; (** GPS comment *)
177
+
desc : string option; (** Point description *)
178
+
src : string option; (** Source of data *)
179
+
links : link list; (** Related links *)
180
+
sym : string option; (** GPS symbol name *)
181
+
type_ : string option; (** Point classification *)
182
+
fix : fix_type option; (** Type of GPS fix *)
183
+
sat : int option; (** Number of satellites *)
184
+
hdop : float option; (** Horizontal dilution of precision *)
185
+
vdop : float option; (** Vertical dilution of precision *)
186
+
pdop : float option; (** Position dilution of precision *)
187
+
ageofdgpsdata : float option; (** Age of DGPS data *)
188
+
dgpsid : int option; (** DGPS station ID *)
189
+
extensions : extension list; (** Custom extensions *)
190
+
}
191
+
192
+
(** Create basic waypoint data with required coordinates *)
193
+
val make_waypoint_data : latitude -> longitude -> waypoint_data
194
+
195
+
(** Individual waypoint - a point of interest *)
196
+
type waypoint = Types.waypoint
197
+
198
+
(** Route point - point along a planned route *)
199
+
type route_point = Types.route_point
200
+
201
+
(** Track point - recorded position along an actual path *)
202
+
type track_point = Types.track_point
203
+
204
+
(** {3 Routes}
205
+
206
+
A route is an ordered list of waypoints representing a planned path. *)
207
+
208
+
(** Route definition - ordered list of waypoints for navigation *)
209
+
type route = Types.route = {
210
+
name : string option; (** Route name *)
211
+
cmt : string option; (** GPS comment *)
212
+
desc : string option; (** Route description *)
213
+
src : string option; (** Source of data *)
214
+
links : link list; (** Related links *)
215
+
number : int option; (** Route number *)
216
+
type_ : string option; (** Route classification *)
217
+
extensions : extension list; (** Custom extensions *)
218
+
rtepts : route_point list; (** Route points *)
219
+
}
220
+
221
+
(** {3 Tracks}
222
+
223
+
A track represents an actual recorded path, consisting of track segments. *)
224
+
225
+
(** Track segment - continuous set of track points *)
226
+
type track_segment = Types.track_segment = {
227
+
trkpts : track_point list; (** Track points in segment *)
228
+
extensions : extension list; (** Custom extensions *)
229
+
}
230
+
231
+
(** Track definition - recorded path made up of segments *)
232
+
type track = Types.track = {
233
+
name : string option; (** Track name *)
234
+
cmt : string option; (** GPS comment *)
235
+
desc : string option; (** Track description *)
236
+
src : string option; (** Source of data *)
237
+
links : link list; (** Related links *)
238
+
number : int option; (** Track number *)
239
+
type_ : string option; (** Track classification *)
240
+
extensions : extension list; (** Custom extensions *)
241
+
trksegs : track_segment list; (** Track segments *)
242
+
}
243
+
244
+
(** {3 Main GPX Document}
245
+
246
+
The root GPX element contains metadata and collections of waypoints, routes, and tracks. *)
247
+
248
+
(** Main GPX document conforming to GPX 1.1 standard *)
249
+
type gpx = Types.gpx = {
250
+
version : string; (** GPX version (always "1.1") *)
251
+
creator : string; (** Creating application *)
252
+
metadata : metadata option; (** File metadata *)
253
+
waypoints : waypoint list; (** Waypoints *)
254
+
routes : route list; (** Routes *)
255
+
tracks : track list; (** Tracks *)
256
+
extensions : extension list; (** Custom extensions *)
257
+
}
258
+
259
+
(** Create GPX document with required creator field *)
260
+
val make_gpx : creator:string -> gpx
261
+
262
+
(** {3 Error Handling} *)
263
+
264
+
(** Errors that can occur during GPX processing *)
265
+
type error = Types.error =
266
+
| Invalid_xml of string (** XML parsing error *)
267
+
| Invalid_coordinate of string (** Coordinate validation error *)
268
+
| Missing_required_attribute of string * string (** Missing XML attribute *)
269
+
| Missing_required_element of string (** Missing XML element *)
270
+
| Validation_error of string (** GPX validation error *)
271
+
| Xml_error of string (** XML processing error *)
272
+
| IO_error of string (** I/O error *)
273
+
274
+
(** Exception type for GPX errors *)
275
+
exception Gpx_error of error
276
+
277
+
(** Result type for operations that may fail *)
278
+
type 'a result = ('a, error) Result.t
279
+
280
+
(** {2 Parsing Functions}
281
+
282
+
Parse GPX documents from XML input sources. *)
283
+
284
+
(** Parse GPX document from xmlm input source.
285
+
@param input The xmlm input source
286
+
@return [Ok gpx] on success, [Error err] on failure *)
287
+
val parse : Xmlm.input -> gpx result
288
+
289
+
(** Parse GPX document from string.
290
+
@param xml_string GPX document as XML string
291
+
@return [Ok gpx] on success, [Error err] on failure *)
292
+
val parse_string : string -> gpx result
293
+
294
+
(** {2 Writing Functions}
295
+
296
+
Generate GPX XML from document structures. *)
297
+
298
+
(** Write GPX document to xmlm output destination.
299
+
@param output The xmlm output destination
300
+
@param gpx The GPX document to write
301
+
@return [Ok ()] on success, [Error err] on failure *)
302
+
val write : Xmlm.output -> gpx -> unit result
303
+
304
+
(** Write GPX document to XML string.
305
+
@param gpx The GPX document to write
306
+
@return [Ok xml_string] on success, [Error err] on failure *)
307
+
val write_string : gpx -> string result
308
+
309
+
(** {2 Validation Functions}
310
+
311
+
Validate GPX documents for correctness and best practices. *)
312
+
313
+
(** Validation issue with severity level *)
314
+
type validation_issue = Validate.validation_issue = {
315
+
level : [`Error | `Warning]; (** Severity level *)
316
+
message : string; (** Issue description *)
317
+
location : string option; (** Location in document *)
318
+
}
319
+
320
+
(** Result of validation containing all issues found *)
321
+
type validation_result = Validate.validation_result = {
322
+
issues : validation_issue list; (** All validation issues *)
323
+
is_valid : bool; (** True if no errors found *)
324
+
}
325
+
326
+
(** Validate complete GPX document.
327
+
Checks coordinates, required fields, and best practices.
328
+
@param gpx GPX document to validate
329
+
@return Validation result with any issues found *)
330
+
val validate_gpx : gpx -> validation_result
331
+
332
+
(** Quick validation check.
333
+
@param gpx GPX document to validate
334
+
@return [true] if document is valid (no errors) *)
335
+
val is_valid : gpx -> bool
336
+
337
+
(** Get only error-level validation issues.
338
+
@param gpx GPX document to validate
339
+
@return List of validation errors *)
340
+
val get_errors : gpx -> validation_issue list
341
+
342
+
(** Get only warning-level validation issues.
343
+
@param gpx GPX document to validate
344
+
@return List of validation warnings *)
345
+
val get_warnings : gpx -> validation_issue list
346
+
347
+
(** Format validation issue for display.
348
+
@param issue Validation issue to format
349
+
@return Human-readable error message *)
350
+
val format_issue : validation_issue -> string
351
+
352
+
(** {2 Module Access}
353
+
354
+
Direct access to submodules for advanced usage. *)
355
+
356
+
(** Core type definitions and utilities *)
45
357
module Types = Types
46
358
47
-
(** {2 Streaming Parser}
48
-
49
-
Memory-efficient streaming XML parser for GPX documents.
50
-
51
-
Features:
52
-
- Validates coordinates and GPS fix types during parsing
53
-
- Handles extensions and custom elements
54
-
- Reports detailed parsing errors with location information
55
-
- Works with any [Xmlm.input] source *)
359
+
(** Streaming XML parser *)
56
360
module Parser = Parser
57
361
58
-
(** {2 Streaming Writer}
59
-
60
-
Memory-efficient streaming XML writer for GPX documents.
61
-
62
-
Features:
63
-
- Generates compliant GPX 1.1 XML
64
-
- Handles proper namespace declarations
65
-
- Supports extensions and custom elements
66
-
- Works with any [Xmlm.output] destination *)
362
+
(** Streaming XML writer *)
67
363
module Writer = Writer
68
364
69
-
(** {2 Validation Engine}
70
-
71
-
Comprehensive validation for GPX documents with detailed error reporting.
72
-
73
-
Features:
74
-
- Validates coordinates are within proper ranges
75
-
- Checks required fields and proper structure
76
-
- Provides warnings for best practices
77
-
- Supports custom validation rules *)
78
-
module Validate = Validate
365
+
(** Validation engine *)
366
+
module Validate = Validate
+2
-2
lib/gpx/parser.ml
+2
-2
lib/gpx/parser.ml
···
6
6
type parser_state = {
7
7
input : Xmlm.input;
8
8
mutable current_element : string list; (* Stack of current element names *)
9
-
mutable text_buffer : Buffer.t;
9
+
text_buffer : Buffer.t;
10
10
}
11
11
12
12
(** Create a new parser state *)
···
516
516
(** Parse from string *)
517
517
let parse_string s =
518
518
let input = Xmlm.make_input (`String (0, s)) in
519
-
parse input
519
+
parse input
+3
-3
lib/gpx/writer.ml
+3
-3
lib/gpx/writer.ml
···
73
73
74
74
(** Write GPX header and DTD *)
75
75
let write_header writer =
76
-
let* () = output_signal writer (`Dtd (Some "<?xml version=\"1.0\" encoding=\"UTF-8\"?>")) in
76
+
let* () = output_signal writer (`Dtd None) in
77
77
Ok ()
78
78
79
79
(** Write link element *)
···
301
301
let attrs = [
302
302
(("", "version"), gpx.version);
303
303
(("", "creator"), gpx.creator);
304
-
(("xmlns", "xsi"), "http://www.w3.org/2001/XMLSchema-instance");
305
304
(("", "xmlns"), "http://www.topografix.com/GPX/1/1");
306
-
(("xsi", "schemaLocation"), "http://www.topografix.com/GPX/1/1 http://www.topografix.com/GPX/1/1/gpx.xsd");
305
+
(("http://www.w3.org/2000/xmlns/", "xsi"), "http://www.w3.org/2001/XMLSchema-instance");
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
+5
lib/gpx_eio/dune
+5
lib/gpx_eio/dune
+155
lib/gpx_eio/gpx_eio.ml
+155
lib/gpx_eio/gpx_eio.ml
···
1
+
(** High-level Eio API for GPX operations *)
2
+
3
+
(* I/O module *)
4
+
module IO = Gpx_io
5
+
6
+
(** Convenience functions for common operations *)
7
+
8
+
(** Read and parse GPX file *)
9
+
let read ~fs path = IO.read_file ~fs path
10
+
11
+
(** Read and parse GPX file with validation *)
12
+
let read_validated ~fs path = IO.read_file_validated ~fs path
13
+
14
+
(** Write GPX to file *)
15
+
let write ~fs path gpx = IO.write_file ~fs path gpx
16
+
17
+
(** Write GPX to file with validation *)
18
+
let write_validated ~fs path gpx = IO.write_file_validated ~fs path gpx
19
+
20
+
(** Write GPX to file with backup *)
21
+
let write_with_backup ~fs path gpx = IO.write_file_with_backup ~fs path gpx
22
+
23
+
(** Read GPX from Eio source *)
24
+
let from_source source = IO.read_source source
25
+
26
+
(** Write GPX to Eio sink *)
27
+
let to_sink sink gpx = IO.write_sink sink gpx
28
+
29
+
(** Read GPX from Eio source with validation *)
30
+
let from_source_validated source = IO.read_source_validated source
31
+
32
+
(** Write GPX to Eio sink with validation *)
33
+
let to_sink_validated sink gpx = IO.write_sink_validated sink gpx
34
+
35
+
(** Create simple waypoint *)
36
+
let make_waypoint ~fs:_ ~lat ~lon ?name ?desc () =
37
+
match Gpx.latitude lat, Gpx.longitude lon with
38
+
| Ok lat, Ok lon ->
39
+
let wpt = Gpx.make_waypoint_data lat lon in
40
+
{ wpt with name; desc }
41
+
| Error e, _ | _, Error e -> raise (Gpx.Gpx_error (Gpx.Invalid_coordinate e))
42
+
43
+
(** Create simple track from coordinate list *)
44
+
let make_track_from_coords ~fs:_ ~name coords =
45
+
let make_trkpt (lat_f, lon_f) =
46
+
match Gpx.latitude lat_f, Gpx.longitude lon_f with
47
+
| Ok lat, Ok lon -> Gpx.make_waypoint_data lat lon
48
+
| Error e, _ | _, Error e -> raise (Gpx.Gpx_error (Gpx.Invalid_coordinate e))
49
+
in
50
+
let trkpts = List.map make_trkpt coords in
51
+
let trkseg : Gpx.track_segment = { trkpts; extensions = [] } in
52
+
({
53
+
name = Some name;
54
+
cmt = None; desc = None; src = None; links = [];
55
+
number = None; type_ = None; extensions = [];
56
+
trksegs = [trkseg];
57
+
} : Gpx.track)
58
+
59
+
(** Create simple route from coordinate list *)
60
+
let make_route_from_coords ~fs:_ ~name coords =
61
+
let make_rtept (lat_f, lon_f) =
62
+
match Gpx.latitude lat_f, Gpx.longitude lon_f with
63
+
| Ok lat, Ok lon -> Gpx.make_waypoint_data lat lon
64
+
| Error e, _ | _, Error e -> raise (Gpx.Gpx_error (Gpx.Invalid_coordinate e))
65
+
in
66
+
let rtepts = List.map make_rtept coords in
67
+
({
68
+
name = Some name;
69
+
cmt = None; desc = None; src = None; links = [];
70
+
number = None; type_ = None; extensions = [];
71
+
rtepts;
72
+
} : Gpx.route)
73
+
74
+
(** Extract coordinates from waypoints *)
75
+
let waypoint_coords (wpt : Gpx.waypoint_data) =
76
+
(Gpx.latitude_to_float wpt.lat, Gpx.longitude_to_float wpt.lon)
77
+
78
+
(** Extract coordinates from track *)
79
+
let track_coords (track : Gpx.track) =
80
+
List.fold_left (fun acc (trkseg : Gpx.track_segment) ->
81
+
List.fold_left (fun acc trkpt ->
82
+
waypoint_coords trkpt :: acc
83
+
) acc trkseg.trkpts
84
+
) [] track.trksegs
85
+
|> List.rev
86
+
87
+
(** Extract coordinates from route *)
88
+
let route_coords (route : Gpx.route) =
89
+
List.map waypoint_coords route.rtepts
90
+
91
+
(** Count total points in GPX *)
92
+
let count_points (gpx : Gpx.gpx) =
93
+
let waypoint_count = List.length gpx.waypoints in
94
+
let route_count = List.fold_left (fun acc (route : Gpx.route) ->
95
+
acc + List.length route.rtepts
96
+
) 0 gpx.routes in
97
+
let track_count = List.fold_left (fun acc (track : Gpx.track) ->
98
+
List.fold_left (fun acc (trkseg : Gpx.track_segment) ->
99
+
acc + List.length trkseg.trkpts
100
+
) acc track.trksegs
101
+
) 0 gpx.tracks in
102
+
waypoint_count + route_count + track_count
103
+
104
+
(** Get GPX statistics *)
105
+
type gpx_stats = {
106
+
waypoint_count : int;
107
+
route_count : int;
108
+
track_count : int;
109
+
total_points : int;
110
+
has_elevation : bool;
111
+
has_time : bool;
112
+
}
113
+
114
+
let get_stats (gpx : Gpx.gpx) =
115
+
let waypoint_count = List.length gpx.waypoints in
116
+
let route_count = List.length gpx.routes in
117
+
let track_count = List.length gpx.tracks in
118
+
let total_points = count_points gpx in
119
+
120
+
let has_elevation =
121
+
List.exists (fun (wpt : Gpx.waypoint_data) -> wpt.ele <> None) gpx.waypoints ||
122
+
List.exists (fun (route : Gpx.route) ->
123
+
List.exists (fun (rtept : Gpx.waypoint_data) -> rtept.ele <> None) route.rtepts
124
+
) gpx.routes ||
125
+
List.exists (fun (track : Gpx.track) ->
126
+
List.exists (fun (trkseg : Gpx.track_segment) ->
127
+
List.exists (fun (trkpt : Gpx.waypoint_data) -> trkpt.ele <> None) trkseg.trkpts
128
+
) track.trksegs
129
+
) gpx.tracks
130
+
in
131
+
132
+
let has_time =
133
+
List.exists (fun (wpt : Gpx.waypoint_data) -> wpt.time <> None) gpx.waypoints ||
134
+
List.exists (fun (route : Gpx.route) ->
135
+
List.exists (fun (rtept : Gpx.waypoint_data) -> rtept.time <> None) route.rtepts
136
+
) gpx.routes ||
137
+
List.exists (fun (track : Gpx.track) ->
138
+
List.exists (fun (trkseg : Gpx.track_segment) ->
139
+
List.exists (fun (trkpt : Gpx.waypoint_data) -> trkpt.time <> None) trkseg.trkpts
140
+
) track.trksegs
141
+
) gpx.tracks
142
+
in
143
+
144
+
{ waypoint_count; route_count; track_count; total_points; has_elevation; has_time }
145
+
146
+
(** Pretty print GPX statistics *)
147
+
let print_stats (gpx : Gpx.gpx) =
148
+
let stats = get_stats gpx in
149
+
Printf.printf "GPX Statistics:\n";
150
+
Printf.printf " Waypoints: %d\n" stats.waypoint_count;
151
+
Printf.printf " Routes: %d\n" stats.route_count;
152
+
Printf.printf " Tracks: %d\n" stats.track_count;
153
+
Printf.printf " Total points: %d\n" stats.total_points;
154
+
Printf.printf " Has elevation data: %s\n" (if stats.has_elevation then "yes" else "no");
155
+
Printf.printf " Has time data: %s\n" (if stats.has_time then "yes" else "no")
+178
lib/gpx_eio/gpx_eio.mli
+178
lib/gpx_eio/gpx_eio.mli
···
1
+
(** {1 GPX Eio - High-level Eio API for GPX operations}
2
+
3
+
This module provides a high-level API for GPX operations using Eio's
4
+
effects-based concurrent I/O system. It offers convenient functions
5
+
for common GPX operations while maintaining structured concurrency.
6
+
7
+
{2 Key Features}
8
+
9
+
- Effects-based I/O using Eio
10
+
- Structured concurrency compatible
11
+
- Resource-safe operations
12
+
- Exception-based error handling (raises [Gpx.Gpx_error])
13
+
- Concurrent processing capabilities
14
+
15
+
{2 Usage Example}
16
+
17
+
{[
18
+
open Gpx_eio
19
+
20
+
let main env =
21
+
let fs = Eio.Stdenv.fs env in
22
+
23
+
(* Create a GPX document *)
24
+
let lat = Gpx.latitude 37.7749 |> Result.get_ok in
25
+
let lon = Gpx.longitude (-122.4194) |> Result.get_ok in
26
+
let wpt = make_waypoint fs ~lat:(Gpx.latitude_to_float lat) ~lon:(Gpx.longitude_to_float lon) ~name:"San Francisco" () in
27
+
let gpx = Gpx.make_gpx ~creator:"eio-example" in
28
+
let gpx = { gpx with waypoints = [wpt] } in
29
+
30
+
(* Write with validation *)
31
+
write_validated fs "output.gpx" gpx;
32
+
33
+
(* Read it back *)
34
+
let gpx2 = read_validated fs "output.gpx" in
35
+
Printf.printf "Read %d waypoints\n" (List.length gpx2.waypoints)
36
+
37
+
let () = Eio_main.run main
38
+
]}
39
+
40
+
{2 Module Re-exports} *)
41
+
42
+
(* I/O module *)
43
+
module IO = Gpx_io
44
+
45
+
(** {2 Convenience File Operations}
46
+
47
+
These functions provide simple file I/O with the filesystem from [Eio.Stdenv.fs]. *)
48
+
49
+
(** Read and parse GPX file.
50
+
@param fs Filesystem capability
51
+
@param path File path to read
52
+
@return GPX document
53
+
@raises Gpx.Gpx_error on read or parse failure *)
54
+
val read : fs:[> Eio.Fs.dir_ty ] Eio.Path.t -> string -> Gpx.gpx
55
+
56
+
(** Read and parse GPX file with validation.
57
+
@param fs Filesystem capability
58
+
@param path File path to read
59
+
@return Valid GPX document
60
+
@raises Gpx.Gpx_error on validation failure *)
61
+
val read_validated : fs:[> Eio.Fs.dir_ty ] Eio.Path.t -> string -> Gpx.gpx
62
+
63
+
(** Write GPX to file.
64
+
@param fs Filesystem capability
65
+
@param path File path to write
66
+
@param gpx GPX document to write
67
+
@raises Gpx.Gpx_error on write failure *)
68
+
val write : fs:[> Eio.Fs.dir_ty ] Eio.Path.t -> string -> Gpx.gpx -> unit
69
+
70
+
(** Write GPX to file with validation.
71
+
@param fs Filesystem capability
72
+
@param path File path to write
73
+
@param gpx GPX document to write
74
+
@raises Gpx.Gpx_error on validation or write failure *)
75
+
val write_validated : fs:[> Eio.Fs.dir_ty ] Eio.Path.t -> string -> Gpx.gpx -> unit
76
+
77
+
(** Write GPX to file with automatic backup.
78
+
@param fs Filesystem capability
79
+
@param path File path to write
80
+
@param gpx GPX document to write
81
+
@return Backup file path (empty if no backup created)
82
+
@raises Gpx.Gpx_error on failure *)
83
+
val write_with_backup : fs:[> Eio.Fs.dir_ty ] Eio.Path.t -> string -> Gpx.gpx -> string
84
+
85
+
(** {2 Stream Operations}
86
+
87
+
Operations for reading/writing GPX from/to Eio flows. *)
88
+
89
+
(** Read GPX from Eio source.
90
+
@param source Input flow
91
+
@return GPX document
92
+
@raises Gpx.Gpx_error on read or parse failure *)
93
+
val from_source : [> Eio.Flow.source_ty ] Eio.Resource.t -> Gpx.gpx
94
+
95
+
(** Write GPX to Eio sink.
96
+
@param sink Output flow
97
+
@param gpx GPX document
98
+
@raises Gpx.Gpx_error on write failure *)
99
+
val to_sink : [> Eio.Flow.sink_ty ] Eio.Resource.t -> Gpx.gpx -> unit
100
+
101
+
(** Read GPX from Eio source with validation.
102
+
@param source Input flow
103
+
@return Valid GPX document
104
+
@raises Gpx.Gpx_error on validation failure *)
105
+
val from_source_validated : [> Eio.Flow.source_ty ] Eio.Resource.t -> Gpx.gpx
106
+
107
+
(** Write GPX to Eio sink with validation.
108
+
@param sink Output flow
109
+
@param gpx GPX document
110
+
@raises Gpx.Gpx_error on validation failure *)
111
+
val to_sink_validated : [> Eio.Flow.sink_ty ] Eio.Resource.t -> Gpx.gpx -> unit
112
+
113
+
(** {2 Utility Functions} *)
114
+
115
+
(** Create simple waypoint with coordinates.
116
+
@param fs Filesystem capability (unused, for API consistency)
117
+
@param lat Latitude in degrees
118
+
@param lon Longitude in degrees
119
+
@param ?name Optional waypoint name
120
+
@param ?desc Optional waypoint description
121
+
@return Waypoint data
122
+
@raises Gpx.Gpx_error on invalid coordinates *)
123
+
val make_waypoint : fs:[> Eio.Fs.dir_ty ] Eio.Path.t -> lat:float -> lon:float -> ?name:string -> ?desc:string -> unit -> Gpx.waypoint_data
124
+
125
+
(** Create track from coordinate list.
126
+
@param fs Filesystem capability (unused, for API consistency)
127
+
@param name Track name
128
+
@param coords List of (latitude, longitude) pairs
129
+
@return Track with single segment
130
+
@raises Gpx.Gpx_error on invalid coordinates *)
131
+
val make_track_from_coords : fs:[> Eio.Fs.dir_ty ] Eio.Path.t -> name:string -> (float * float) list -> Gpx.track
132
+
133
+
(** Create route from coordinate list.
134
+
@param fs Filesystem capability (unused, for API consistency)
135
+
@param name Route name
136
+
@param coords List of (latitude, longitude) pairs
137
+
@return Route
138
+
@raises Gpx.Gpx_error on invalid coordinates *)
139
+
val make_route_from_coords : fs:[> Eio.Fs.dir_ty ] Eio.Path.t -> name:string -> (float * float) list -> Gpx.route
140
+
141
+
(** Extract coordinates from waypoint.
142
+
@param wpt Waypoint data
143
+
@return (latitude, longitude) as floats *)
144
+
val waypoint_coords : Gpx.waypoint_data -> float * float
145
+
146
+
(** Extract coordinates from track.
147
+
@param track Track
148
+
@return List of (latitude, longitude) pairs *)
149
+
val track_coords : Gpx.track -> (float * float) list
150
+
151
+
(** Extract coordinates from route.
152
+
@param route Route
153
+
@return List of (latitude, longitude) pairs *)
154
+
val route_coords : Gpx.route -> (float * float) list
155
+
156
+
(** Count total points in GPX document.
157
+
@param gpx GPX document
158
+
@return Total number of waypoints, route points, and track points *)
159
+
val count_points : Gpx.gpx -> int
160
+
161
+
(** GPX statistics record *)
162
+
type gpx_stats = {
163
+
waypoint_count : int; (** Number of waypoints *)
164
+
route_count : int; (** Number of routes *)
165
+
track_count : int; (** Number of tracks *)
166
+
total_points : int; (** Total geographic points *)
167
+
has_elevation : bool; (** Document contains elevation data *)
168
+
has_time : bool; (** Document contains time data *)
169
+
}
170
+
171
+
(** Get GPX document statistics.
172
+
@param gpx GPX document
173
+
@return Statistics summary *)
174
+
val get_stats : Gpx.gpx -> gpx_stats
175
+
176
+
(** Print GPX statistics to stdout.
177
+
@param gpx GPX document *)
178
+
val print_stats : Gpx.gpx -> unit
+116
lib/gpx_eio/gpx_io.ml
+116
lib/gpx_eio/gpx_io.ml
···
1
+
(** GPX Eio I/O operations *)
2
+
3
+
(* Real Eio-based I/O operations *)
4
+
5
+
(** Read GPX from file path *)
6
+
let read_file ~fs path =
7
+
let content = Eio.Path.load Eio.Path.(fs / path) in
8
+
match Gpx.parse_string content with
9
+
| Ok gpx -> gpx
10
+
| Error err -> raise (Gpx.Gpx_error err)
11
+
12
+
(** Write GPX to file path *)
13
+
let write_file ~fs path gpx =
14
+
match Gpx.write_string gpx with
15
+
| Ok xml_string ->
16
+
Eio.Path.save ~create:(`Or_truncate 0o644) Eio.Path.(fs / path) xml_string
17
+
| Error err -> raise (Gpx.Gpx_error err)
18
+
19
+
(** Read GPX from file with validation *)
20
+
let read_file_validated ~fs path =
21
+
let gpx = read_file ~fs path in
22
+
let validation = Gpx.validate_gpx gpx in
23
+
if validation.is_valid then
24
+
gpx
25
+
else
26
+
let errors = Gpx.get_errors gpx in
27
+
let error_msgs = List.map Gpx.format_issue errors in
28
+
raise (Gpx.Gpx_error (Gpx.Validation_error (String.concat "; " error_msgs)))
29
+
30
+
(** Write GPX to file with validation *)
31
+
let write_file_validated ~fs path gpx =
32
+
let validation = Gpx.validate_gpx gpx in
33
+
if not validation.is_valid then
34
+
let errors = Gpx.get_errors gpx in
35
+
let error_msgs = List.map Gpx.format_issue errors in
36
+
raise (Gpx.Gpx_error (Gpx.Validation_error (String.concat "; " error_msgs)))
37
+
else
38
+
write_file ~fs path gpx
39
+
40
+
(** Read GPX from Eio source *)
41
+
let read_source source =
42
+
let content = Eio.Flow.read_all source in
43
+
match Gpx.parse_string content with
44
+
| Ok gpx -> gpx
45
+
| Error err -> raise (Gpx.Gpx_error err)
46
+
47
+
(** Write GPX to Eio sink *)
48
+
let write_sink sink gpx =
49
+
match Gpx.write_string gpx with
50
+
| Ok xml_string ->
51
+
Eio.Flow.copy_string xml_string sink
52
+
| Error err -> raise (Gpx.Gpx_error err)
53
+
54
+
(** Read GPX from Eio source with validation *)
55
+
let read_source_validated source =
56
+
let gpx = read_source source in
57
+
let validation = Gpx.validate_gpx gpx in
58
+
if validation.is_valid then
59
+
gpx
60
+
else
61
+
let errors = Gpx.get_errors gpx in
62
+
let error_msgs = List.map Gpx.format_issue errors in
63
+
raise (Gpx.Gpx_error (Gpx.Validation_error (String.concat "; " error_msgs)))
64
+
65
+
(** Write GPX to Eio sink with validation *)
66
+
let write_sink_validated sink gpx =
67
+
let validation = Gpx.validate_gpx gpx in
68
+
if not validation.is_valid then
69
+
let errors = Gpx.get_errors gpx in
70
+
let error_msgs = List.map Gpx.format_issue errors in
71
+
raise (Gpx.Gpx_error (Gpx.Validation_error (String.concat "; " error_msgs)))
72
+
else
73
+
write_sink sink gpx
74
+
75
+
(** Check if file exists *)
76
+
let file_exists ~fs path =
77
+
try
78
+
let _stat = Eio.Path.stat ~follow:true Eio.Path.(fs / path) in
79
+
true
80
+
with
81
+
| _ -> false
82
+
83
+
(** Get file size *)
84
+
let file_size ~fs path =
85
+
try
86
+
let stat = Eio.Path.stat ~follow:true Eio.Path.(fs / path) in
87
+
Optint.Int63.to_int stat.size
88
+
with
89
+
| exn -> raise (Gpx.Gpx_error (Gpx.IO_error (Printexc.to_string exn)))
90
+
91
+
(** Create backup of existing file *)
92
+
let create_backup ~fs path =
93
+
if file_exists ~fs path then
94
+
let backup_path = path ^ ".backup" in
95
+
let content = Eio.Path.load Eio.Path.(fs / path) in
96
+
Eio.Path.save ~create:(`Or_truncate 0o644) Eio.Path.(fs / backup_path) content;
97
+
backup_path
98
+
else
99
+
""
100
+
101
+
(** Write GPX to file with automatic backup *)
102
+
let write_file_with_backup ~fs path gpx =
103
+
let backup_path = create_backup ~fs path in
104
+
try
105
+
write_file ~fs path gpx;
106
+
backup_path
107
+
with
108
+
| Gpx.Gpx_error _ as err ->
109
+
(* Try to restore backup if write failed *)
110
+
if backup_path <> "" && file_exists ~fs backup_path then (
111
+
try
112
+
let backup_content = Eio.Path.load Eio.Path.(fs / backup_path) in
113
+
Eio.Path.save ~create:(`Or_truncate 0o644) Eio.Path.(fs / path) backup_content
114
+
with _ -> () (* Ignore restore errors *)
115
+
);
116
+
raise err
+91
lib/gpx_eio/gpx_io.mli
+91
lib/gpx_eio/gpx_io.mli
···
1
+
(** GPX Eio I/O operations
2
+
3
+
This module provides GPX I/O operations using Eio's effects-based
4
+
concurrent I/O system. All operations are structured concurrency
5
+
compatible and work with Eio's resource management.
6
+
*)
7
+
8
+
(** {1 File Operations}
9
+
10
+
All file operations require filesystem access capability. *)
11
+
12
+
(** Read GPX from file path.
13
+
@param fs Filesystem capability
14
+
@param path File path to read
15
+
@return GPX document or error *)
16
+
val read_file : fs:[> Eio.Fs.dir_ty ] Eio.Path.t -> string -> Gpx.gpx
17
+
18
+
(** Write GPX to file path.
19
+
@param fs Filesystem capability
20
+
@param path File path to write
21
+
@param gpx GPX document to write
22
+
@raises Gpx.Gpx_error on write failure *)
23
+
val write_file : fs:[> Eio.Fs.dir_ty ] Eio.Path.t -> string -> Gpx.gpx -> unit
24
+
25
+
(** Read GPX from file with validation.
26
+
@param fs Filesystem capability
27
+
@param path File path to read
28
+
@return Valid GPX document
29
+
@raises Gpx.Gpx_error on validation failure *)
30
+
val read_file_validated : fs:[> Eio.Fs.dir_ty ] Eio.Path.t -> string -> Gpx.gpx
31
+
32
+
(** Write GPX to file with validation.
33
+
@param fs Filesystem capability
34
+
@param path File path to write
35
+
@param gpx GPX document to write
36
+
@raises Gpx.Gpx_error on validation or write failure *)
37
+
val write_file_validated : fs:[> Eio.Fs.dir_ty ] Eio.Path.t -> string -> Gpx.gpx -> unit
38
+
39
+
(** {1 Stream Operations}
40
+
41
+
Read/write GPX from/to Eio flows. *)
42
+
43
+
(** Read GPX from Eio source.
44
+
@param source Input flow to read from
45
+
@return GPX document *)
46
+
val read_source : [> Eio.Flow.source_ty ] Eio.Resource.t -> Gpx.gpx
47
+
48
+
(** Write GPX to Eio sink.
49
+
@param sink Output flow to write to
50
+
@param gpx GPX document to write *)
51
+
val write_sink : [> Eio.Flow.sink_ty ] Eio.Resource.t -> Gpx.gpx -> unit
52
+
53
+
(** Read GPX from Eio source with validation.
54
+
@param source Input flow to read from
55
+
@return Valid GPX document
56
+
@raises Gpx.Gpx_error on validation failure *)
57
+
val read_source_validated : [> Eio.Flow.source_ty ] Eio.Resource.t -> Gpx.gpx
58
+
59
+
(** Write GPX to Eio sink with validation.
60
+
@param sink Output flow to write to
61
+
@param gpx GPX document to write
62
+
@raises Gpx.Gpx_error on validation failure *)
63
+
val write_sink_validated : [> Eio.Flow.sink_ty ] Eio.Resource.t -> Gpx.gpx -> unit
64
+
65
+
(** {1 Utility Functions} *)
66
+
67
+
(** Check if file exists.
68
+
@param fs Filesystem capability
69
+
@param path File path to check
70
+
@return [true] if file exists and is readable *)
71
+
val file_exists : fs:[> Eio.Fs.dir_ty ] Eio.Path.t -> string -> bool
72
+
73
+
(** Get file size.
74
+
@param fs Filesystem capability
75
+
@param path File path
76
+
@return File size in bytes *)
77
+
val file_size : fs:[> Eio.Fs.dir_ty ] Eio.Path.t -> string -> int
78
+
79
+
(** Create backup of existing file.
80
+
@param fs Filesystem capability
81
+
@param path Original file path
82
+
@return Backup file path *)
83
+
val create_backup : fs:[> Eio.Fs.dir_ty ] Eio.Path.t -> string -> string
84
+
85
+
(** Write GPX to file with automatic backup.
86
+
Creates a backup of existing file before writing new content.
87
+
@param fs Filesystem capability
88
+
@param path File path to write
89
+
@param gpx GPX document to write
90
+
@return Backup file path (empty string if no backup needed) *)
91
+
val write_file_with_backup : fs:[> Eio.Fs.dir_ty ] Eio.Path.t -> string -> Gpx.gpx -> string
+103
test/data/comprehensive.gpx
+103
test/data/comprehensive.gpx
···
1
+
<?xml version="1.0" encoding="UTF-8"?>
2
+
<gpx version="1.1" creator="mlgpx comprehensive test"
3
+
xmlns="http://www.topografix.com/GPX/1/1">
4
+
<metadata>
5
+
<name>Comprehensive GPX Test</name>
6
+
<desc>Contains waypoints, routes, and tracks together</desc>
7
+
<author>
8
+
<name>Test Suite</name>
9
+
<email id="test" domain="example.com"/>
10
+
</author>
11
+
<copyright author="Test Suite">
12
+
<year>2024</year>
13
+
<license>MIT</license>
14
+
</copyright>
15
+
<time>2024-01-15T12:00:00Z</time>
16
+
<keywords>test, gpx, comprehensive</keywords>
17
+
<bounds minlat="37.7" maxlat="37.8" minlon="-122.5" maxlon="-122.4"/>
18
+
</metadata>
19
+
20
+
<!-- Waypoints -->
21
+
<wpt lat="37.7749" lon="-122.4194">
22
+
<ele>52.0</ele>
23
+
<time>2024-01-15T08:00:00Z</time>
24
+
<name>Start Point</name>
25
+
<desc>Beginning of our journey</desc>
26
+
<type>start</type>
27
+
</wpt>
28
+
<wpt lat="37.7849" lon="-122.4094">
29
+
<ele>100.5</ele>
30
+
<time>2024-01-15T12:00:00Z</time>
31
+
<name>End Point</name>
32
+
<desc>End of our journey</desc>
33
+
<type>finish</type>
34
+
</wpt>
35
+
36
+
<!-- Route -->
37
+
<rte>
38
+
<name>Planned Route</name>
39
+
<desc>The route we intended to take</desc>
40
+
<rtept lat="37.7749" lon="-122.4194">
41
+
<name>Start</name>
42
+
</rtept>
43
+
<rtept lat="37.7799" lon="-122.4144">
44
+
<name>Midpoint</name>
45
+
</rtept>
46
+
<rtept lat="37.7849" lon="-122.4094">
47
+
<name>End</name>
48
+
</rtept>
49
+
</rte>
50
+
51
+
<!-- Track -->
52
+
<trk>
53
+
<name>Actual Track</name>
54
+
<desc>The track we actually took</desc>
55
+
<type>walking</type>
56
+
<trkseg>
57
+
<trkpt lat="37.7749" lon="-122.4194">
58
+
<ele>52.0</ele>
59
+
<time>2024-01-15T08:00:00Z</time>
60
+
</trkpt>
61
+
<trkpt lat="37.7759" lon="-122.4184">
62
+
<ele>55.2</ele>
63
+
<time>2024-01-15T08:05:00Z</time>
64
+
</trkpt>
65
+
<trkpt lat="37.7769" lon="-122.4174">
66
+
<ele>58.8</ele>
67
+
<time>2024-01-15T08:10:00Z</time>
68
+
</trkpt>
69
+
<trkpt lat="37.7779" lon="-122.4164">
70
+
<ele>62.1</ele>
71
+
<time>2024-01-15T08:15:00Z</time>
72
+
</trkpt>
73
+
<trkpt lat="37.7789" lon="-122.4154">
74
+
<ele>65.5</ele>
75
+
<time>2024-01-15T08:20:00Z</time>
76
+
</trkpt>
77
+
<trkpt lat="37.7799" lon="-122.4144">
78
+
<ele>68.9</ele>
79
+
<time>2024-01-15T08:25:00Z</time>
80
+
</trkpt>
81
+
<trkpt lat="37.7809" lon="-122.4134">
82
+
<ele>72.3</ele>
83
+
<time>2024-01-15T08:30:00Z</time>
84
+
</trkpt>
85
+
<trkpt lat="37.7819" lon="-122.4124">
86
+
<ele>75.7</ele>
87
+
<time>2024-01-15T08:35:00Z</time>
88
+
</trkpt>
89
+
<trkpt lat="37.7829" lon="-122.4114">
90
+
<ele>79.1</ele>
91
+
<time>2024-01-15T08:40:00Z</time>
92
+
</trkpt>
93
+
<trkpt lat="37.7839" lon="-122.4104">
94
+
<ele>82.5</ele>
95
+
<time>2024-01-15T08:45:00Z</time>
96
+
</trkpt>
97
+
<trkpt lat="37.7849" lon="-122.4094">
98
+
<ele>85.9</ele>
99
+
<time>2024-01-15T08:50:00Z</time>
100
+
</trkpt>
101
+
</trkseg>
102
+
</trk>
103
+
</gpx>
+35
test/data/detailed_waypoints.gpx
+35
test/data/detailed_waypoints.gpx
···
1
+
<?xml version="1.0" encoding="UTF-8"?>
2
+
<gpx version="1.1" creator="mlgpx test suite"
3
+
xmlns="http://www.topografix.com/GPX/1/1">
4
+
<metadata>
5
+
<name>Detailed Waypoints</name>
6
+
<desc>Waypoints with elevation, time, and full metadata</desc>
7
+
<time>2024-01-15T10:30:00Z</time>
8
+
<bounds minlat="37.7" maxlat="37.8" minlon="-122.5" maxlon="-122.4"/>
9
+
</metadata>
10
+
<wpt lat="37.7849" lon="-122.4094">
11
+
<ele>100.5</ele>
12
+
<time>2024-01-15T10:00:00Z</time>
13
+
<name>Golden Gate Bridge</name>
14
+
<desc>Famous suspension bridge</desc>
15
+
<type>landmark</type>
16
+
<fix>3d</fix>
17
+
<sat>8</sat>
18
+
<hdop>1.2</hdop>
19
+
<vdop>1.8</vdop>
20
+
<pdop>2.1</pdop>
21
+
<link href="https://www.nps.gov/goga/">
22
+
<text>Golden Gate National Recreation Area</text>
23
+
<type>text/html</type>
24
+
</link>
25
+
</wpt>
26
+
<wpt lat="37.7749" lon="-122.4194">
27
+
<ele>52.0</ele>
28
+
<time>2024-01-15T10:15:00Z</time>
29
+
<name>Lombard Street</name>
30
+
<desc>Most crooked street in the world</desc>
31
+
<type>attraction</type>
32
+
<fix>2d</fix>
33
+
<sat>6</sat>
34
+
</wpt>
35
+
</gpx>
+37
test/data/edge_cases.gpx
+37
test/data/edge_cases.gpx
···
1
+
<?xml version="1.0" encoding="UTF-8"?>
2
+
<gpx version="1.1" creator="edge case test"
3
+
xmlns="http://www.topografix.com/GPX/1/1">
4
+
<metadata>
5
+
<name>Edge Cases</name>
6
+
<desc>Testing boundary conditions</desc>
7
+
</metadata>
8
+
9
+
<!-- Edge case coordinates -->
10
+
<wpt lat="-90.0" lon="-180.0">
11
+
<name>South Pole</name>
12
+
<desc>Minimum latitude and longitude</desc>
13
+
</wpt>
14
+
<wpt lat="90.0" lon="179.999999">
15
+
<name>North Pole Area</name>
16
+
<desc>Maximum latitude, near maximum longitude</desc>
17
+
</wpt>
18
+
<wpt lat="0.0" lon="0.0">
19
+
<name>Null Island</name>
20
+
<desc>Zero coordinates</desc>
21
+
</wpt>
22
+
23
+
<!-- Track with extreme elevation -->
24
+
<trk>
25
+
<name>Extreme Elevations</name>
26
+
<trkseg>
27
+
<trkpt lat="28.0" lon="86.9">
28
+
<ele>8848.86</ele>
29
+
<name>Everest Summit</name>
30
+
</trkpt>
31
+
<trkpt lat="31.5" lon="35.4">
32
+
<ele>-430.0</ele>
33
+
<name>Dead Sea</name>
34
+
</trkpt>
35
+
</trkseg>
36
+
</trk>
37
+
</gpx>
+13
test/data/invalid.gpx
+13
test/data/invalid.gpx
···
1
+
<?xml version="1.0" encoding="UTF-8"?>
2
+
<gpx version="1.1" creator="invalid test"
3
+
xmlns="http://www.topografix.com/GPX/1/1">
4
+
<wpt lat="invalid_lat" lon="-122.4194">
5
+
<name>Invalid Waypoint</name>
6
+
</wpt>
7
+
<wpt lat="91.0" lon="-122.4194">
8
+
<name>Invalid Latitude</name>
9
+
</wpt>
10
+
<wpt lat="45.0" lon="-181.0">
11
+
<name>Invalid Longitude</name>
12
+
</wpt>
13
+
</gpx>
+7
test/data/minimal.gpx
+7
test/data/minimal.gpx
+42
test/data/multi_segment_track.gpx
+42
test/data/multi_segment_track.gpx
···
1
+
<?xml version="1.0" encoding="UTF-8"?>
2
+
<gpx version="1.1" creator="mlgpx test suite"
3
+
xmlns="http://www.topografix.com/GPX/1/1">
4
+
<metadata>
5
+
<name>Multi-Segment Track</name>
6
+
<desc>Track with multiple segments and breaks</desc>
7
+
</metadata>
8
+
<trk>
9
+
<name>Hiking Trail</name>
10
+
<desc>Mountain hike with rest stops</desc>
11
+
<type>hiking</type>
12
+
<trkseg>
13
+
<trkpt lat="37.7749" lon="-122.4194">
14
+
<ele>100.0</ele>
15
+
<time>2024-01-15T09:00:00Z</time>
16
+
</trkpt>
17
+
<trkpt lat="37.7759" lon="-122.4184">
18
+
<ele>125.5</ele>
19
+
<time>2024-01-15T09:15:00Z</time>
20
+
</trkpt>
21
+
<trkpt lat="37.7769" lon="-122.4174">
22
+
<ele>150.2</ele>
23
+
<time>2024-01-15T09:30:00Z</time>
24
+
</trkpt>
25
+
</trkseg>
26
+
<!-- Break for lunch -->
27
+
<trkseg>
28
+
<trkpt lat="37.7769" lon="-122.4174">
29
+
<ele>150.2</ele>
30
+
<time>2024-01-15T10:30:00Z</time>
31
+
</trkpt>
32
+
<trkpt lat="37.7779" lon="-122.4164">
33
+
<ele>175.8</ele>
34
+
<time>2024-01-15T10:45:00Z</time>
35
+
</trkpt>
36
+
<trkpt lat="37.7789" lon="-122.4154">
37
+
<ele>200.1</ele>
38
+
<time>2024-01-15T11:00:00Z</time>
39
+
</trkpt>
40
+
</trkseg>
41
+
</trk>
42
+
</gpx>
+29
test/data/simple_route.gpx
+29
test/data/simple_route.gpx
···
1
+
<?xml version="1.0" encoding="UTF-8"?>
2
+
<gpx version="1.1" creator="mlgpx test suite"
3
+
xmlns="http://www.topografix.com/GPX/1/1">
4
+
<metadata>
5
+
<name>Simple Route Test</name>
6
+
<desc>Basic route with waypoints</desc>
7
+
</metadata>
8
+
<rte>
9
+
<name>SF to Oakland</name>
10
+
<desc>Route across the Bay Bridge</desc>
11
+
<number>1</number>
12
+
<type>driving</type>
13
+
<rtept lat="37.7749" lon="-122.4194">
14
+
<name>San Francisco Start</name>
15
+
<desc>Starting point in SF</desc>
16
+
<type>start</type>
17
+
</rtept>
18
+
<rtept lat="37.8044" lon="-122.2711">
19
+
<name>Bay Bridge</name>
20
+
<desc>Crossing the bay</desc>
21
+
<type>waypoint</type>
22
+
</rtept>
23
+
<rtept lat="37.8044" lon="-122.2711">
24
+
<name>Oakland End</name>
25
+
<desc>Destination in Oakland</desc>
26
+
<type>finish</type>
27
+
</rtept>
28
+
</rte>
29
+
</gpx>
+36
test/data/simple_track.gpx
+36
test/data/simple_track.gpx
···
1
+
<?xml version="1.0" encoding="UTF-8"?>
2
+
<gpx version="1.1" creator="mlgpx test suite"
3
+
xmlns="http://www.topografix.com/GPX/1/1">
4
+
<metadata>
5
+
<name>Simple Track Test</name>
6
+
<desc>Basic track recording</desc>
7
+
</metadata>
8
+
<trk>
9
+
<name>Morning Jog</name>
10
+
<desc>Running track around the park</desc>
11
+
<type>running</type>
12
+
<number>1</number>
13
+
<trkseg>
14
+
<trkpt lat="37.7749" lon="-122.4194">
15
+
<ele>15.0</ele>
16
+
<time>2024-01-15T07:00:00Z</time>
17
+
</trkpt>
18
+
<trkpt lat="37.7759" lon="-122.4184">
19
+
<ele>18.2</ele>
20
+
<time>2024-01-15T07:01:00Z</time>
21
+
</trkpt>
22
+
<trkpt lat="37.7769" lon="-122.4174">
23
+
<ele>21.5</ele>
24
+
<time>2024-01-15T07:02:00Z</time>
25
+
</trkpt>
26
+
<trkpt lat="37.7779" lon="-122.4164">
27
+
<ele>19.8</ele>
28
+
<time>2024-01-15T07:03:00Z</time>
29
+
</trkpt>
30
+
<trkpt lat="37.7749" lon="-122.4194">
31
+
<ele>15.0</ele>
32
+
<time>2024-01-15T07:10:00Z</time>
33
+
</trkpt>
34
+
</trkseg>
35
+
</trk>
36
+
</gpx>
+28
test/data/simple_waypoints.gpx
+28
test/data/simple_waypoints.gpx
···
1
+
<?xml version="1.0" encoding="UTF-8"?>
2
+
<gpx version="1.1" creator="mlgpx test suite"
3
+
xsi:schemaLocation="http://www.topografix.com/GPX/1/1 http://www.topografix.com/GPX/1/1/gpx.xsd"
4
+
xmlns="http://www.topografix.com/GPX/1/1"
5
+
xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance">
6
+
<metadata>
7
+
<name>Simple Waypoints Test</name>
8
+
<desc>Basic waypoint test with minimal data</desc>
9
+
<author>
10
+
<name>GPX Test Suite</name>
11
+
</author>
12
+
</metadata>
13
+
<wpt lat="37.7749" lon="-122.4194">
14
+
<name>San Francisco</name>
15
+
<desc>City by the bay</desc>
16
+
<type>city</type>
17
+
</wpt>
18
+
<wpt lat="40.7128" lon="-74.0060">
19
+
<name>New York</name>
20
+
<desc>Big Apple</desc>
21
+
<type>city</type>
22
+
</wpt>
23
+
<wpt lat="34.0522" lon="-118.2437">
24
+
<name>Los Angeles</name>
25
+
<desc>City of Angels</desc>
26
+
<type>city</type>
27
+
</wpt>
28
+
</gpx>
+19
-1
test/dune
+19
-1
test/dune
···
1
1
(executable
2
2
(public_name test_gpx)
3
3
(name test_gpx)
4
-
(libraries gpx gpx_unix))
4
+
(libraries gpx gpx_unix)
5
+
(modules test_gpx))
6
+
7
+
;; ppx_expect inline tests
8
+
(library
9
+
(public_name mlgpx.test)
10
+
(name test_corpus)
11
+
(libraries gpx)
12
+
(inline_tests)
13
+
(preprocess (pps ppx_expect))
14
+
(modules test_corpus))
15
+
16
+
;; Alcotest suite for Unix and Eio comparison
17
+
(executable
18
+
(public_name corpus_test)
19
+
(name test_corpus_unix_eio)
20
+
(libraries gpx gpx_unix gpx_eio alcotest eio_main)
21
+
(optional)
22
+
(modules test_corpus_unix_eio))
+251
test/test_corpus.ml
+251
test/test_corpus.ml
···
1
+
(** Corpus tests using ppx_expect for GPX parsing *)
2
+
3
+
open Gpx
4
+
5
+
let test_data_dir =
6
+
let cwd = Sys.getcwd () in
7
+
let basename = Filename.basename cwd in
8
+
if basename = "test" then
9
+
"data" (* Running from test/ directory *)
10
+
else if basename = "_build" || String.contains cwd '_' then
11
+
"../test/data" (* Running from _build during tests *)
12
+
else
13
+
"test/data" (* Running from project root *)
14
+
15
+
let read_test_file filename =
16
+
let path = Filename.concat test_data_dir filename in
17
+
In_channel.with_open_text path In_channel.input_all
18
+
19
+
let%expect_test "parse simple waypoints" =
20
+
let content = read_test_file "simple_waypoints.gpx" in
21
+
match parse_string content with
22
+
| Ok gpx ->
23
+
Printf.printf "Waypoints count: %d\n" (List.length gpx.waypoints);
24
+
Printf.printf "First waypoint name: %s\n"
25
+
(match gpx.waypoints with
26
+
| wpt :: _ -> (match wpt.name with Some n -> n | None -> "None")
27
+
| [] -> "None");
28
+
Printf.printf "Creator: %s\n" gpx.creator;
29
+
[%expect {|
30
+
Waypoints count: 3
31
+
First waypoint name: San Francisco
32
+
Creator: mlgpx test suite |}]
33
+
| Error err ->
34
+
Printf.printf "Error: %s\n" (match err with
35
+
| Invalid_xml s -> "Invalid XML: " ^ s
36
+
| Invalid_coordinate s -> "Invalid coordinate: " ^ s
37
+
| _ -> "Other error");
38
+
[%expect.unreachable]
39
+
40
+
let%expect_test "parse detailed waypoints" =
41
+
let content = read_test_file "detailed_waypoints.gpx" in
42
+
match parse_string content with
43
+
| Ok gpx ->
44
+
Printf.printf "Waypoints count: %d\n" (List.length gpx.waypoints);
45
+
Printf.printf "Has metadata time: %b\n"
46
+
(match gpx.metadata with Some md -> md.time <> None | None -> false);
47
+
Printf.printf "Has bounds: %b\n"
48
+
(match gpx.metadata with Some md -> md.bounds <> None | None -> false);
49
+
(match gpx.waypoints with
50
+
| wpt :: _ ->
51
+
Printf.printf "First waypoint has elevation: %b\n" (wpt.ele <> None);
52
+
Printf.printf "First waypoint has time: %b\n" (wpt.time <> None);
53
+
Printf.printf "First waypoint has links: %b\n" (wpt.links <> [])
54
+
| [] -> ());
55
+
[%expect {|
56
+
Waypoints count: 2
57
+
Has metadata time: true
58
+
Has bounds: true
59
+
First waypoint has elevation: true
60
+
First waypoint has time: true
61
+
First waypoint has links: true |}]
62
+
| Error _ ->
63
+
Printf.printf "Parse error\n";
64
+
[%expect.unreachable]
65
+
66
+
let%expect_test "parse simple route" =
67
+
let content = read_test_file "simple_route.gpx" in
68
+
match parse_string content with
69
+
| Ok gpx ->
70
+
Printf.printf "Routes count: %d\n" (List.length gpx.routes);
71
+
(match gpx.routes with
72
+
| rte :: _ ->
73
+
Printf.printf "Route name: %s\n"
74
+
(match rte.name with Some n -> n | None -> "None");
75
+
Printf.printf "Route points count: %d\n" (List.length rte.rtepts);
76
+
Printf.printf "Route has number: %b\n" (rte.number <> None)
77
+
| [] -> ());
78
+
[%expect {|
79
+
Routes count: 1
80
+
Route name: SF to Oakland
81
+
Route points count: 3
82
+
Route has number: true |}]
83
+
| Error _ ->
84
+
Printf.printf "Parse error\n";
85
+
[%expect.unreachable]
86
+
87
+
let%expect_test "parse simple track" =
88
+
let content = read_test_file "simple_track.gpx" in
89
+
match parse_string content with
90
+
| Ok gpx ->
91
+
Printf.printf "Tracks count: %d\n" (List.length gpx.tracks);
92
+
(match gpx.tracks with
93
+
| trk :: _ ->
94
+
Printf.printf "Track name: %s\n"
95
+
(match trk.name with Some n -> n | None -> "None");
96
+
Printf.printf "Track segments: %d\n" (List.length trk.trksegs);
97
+
(match trk.trksegs with
98
+
| seg :: _ ->
99
+
Printf.printf "First segment points: %d\n" (List.length seg.trkpts);
100
+
(match seg.trkpts with
101
+
| pt :: _ ->
102
+
Printf.printf "First point has elevation: %b\n" (pt.ele <> None);
103
+
Printf.printf "First point has time: %b\n" (pt.time <> None)
104
+
| [] -> ())
105
+
| [] -> ())
106
+
| [] -> ());
107
+
[%expect {|
108
+
Tracks count: 1
109
+
Track name: Morning Jog
110
+
Track segments: 1
111
+
First segment points: 5
112
+
First point has elevation: true
113
+
First point has time: true |}]
114
+
| Error _ ->
115
+
Printf.printf "Parse error\n";
116
+
[%expect.unreachable]
117
+
118
+
let%expect_test "parse multi-segment track" =
119
+
let content = read_test_file "multi_segment_track.gpx" in
120
+
match parse_string content with
121
+
| Ok gpx ->
122
+
Printf.printf "Tracks count: %d\n" (List.length gpx.tracks);
123
+
(match gpx.tracks with
124
+
| trk :: _ ->
125
+
Printf.printf "Track segments: %d\n" (List.length trk.trksegs);
126
+
let total_points = List.fold_left (fun acc seg ->
127
+
acc + List.length seg.trkpts) 0 trk.trksegs in
128
+
Printf.printf "Total track points: %d\n" total_points
129
+
| [] -> ());
130
+
[%expect {|
131
+
Tracks count: 1
132
+
Track segments: 2
133
+
Total track points: 6 |}]
134
+
| Error _ ->
135
+
Printf.printf "Parse error\n";
136
+
[%expect.unreachable]
137
+
138
+
let%expect_test "parse comprehensive gpx" =
139
+
let content = read_test_file "comprehensive.gpx" in
140
+
match parse_string content with
141
+
| Ok gpx ->
142
+
Printf.printf "Waypoints: %d\n" (List.length gpx.waypoints);
143
+
Printf.printf "Routes: %d\n" (List.length gpx.routes);
144
+
Printf.printf "Tracks: %d\n" (List.length gpx.tracks);
145
+
Printf.printf "Has author: %b\n"
146
+
(match gpx.metadata with Some md -> md.author <> None | None -> false);
147
+
Printf.printf "Has copyright: %b\n"
148
+
(match gpx.metadata with Some md -> md.copyright <> None | None -> false);
149
+
Printf.printf "Has keywords: %b\n"
150
+
(match gpx.metadata with Some md -> md.keywords <> None | None -> false);
151
+
[%expect {|
152
+
Waypoints: 2
153
+
Routes: 1
154
+
Tracks: 1
155
+
Has author: true
156
+
Has copyright: true
157
+
Has keywords: true |}]
158
+
| Error _ ->
159
+
Printf.printf "Parse error\n";
160
+
[%expect.unreachable]
161
+
162
+
let%expect_test "parse minimal gpx" =
163
+
let content = read_test_file "minimal.gpx" in
164
+
match parse_string content with
165
+
| Ok gpx ->
166
+
Printf.printf "Minimal GPX parsed successfully\n";
167
+
Printf.printf "Waypoints: %d\n" (List.length gpx.waypoints);
168
+
Printf.printf "Routes: %d\n" (List.length gpx.routes);
169
+
Printf.printf "Tracks: %d\n" (List.length gpx.tracks);
170
+
[%expect {|
171
+
Minimal GPX parsed successfully
172
+
Waypoints: 1
173
+
Routes: 0
174
+
Tracks: 0 |}]
175
+
| Error err ->
176
+
Printf.printf "Error: %s\n" (match err with
177
+
| Invalid_xml s -> "Invalid XML: " ^ s
178
+
| _ -> "Other error");
179
+
[%expect.unreachable]
180
+
181
+
let%expect_test "parse edge cases" =
182
+
let content = read_test_file "edge_cases.gpx" in
183
+
match parse_string content with
184
+
| Ok gpx ->
185
+
Printf.printf "Edge cases parsed successfully\n";
186
+
Printf.printf "Waypoints: %d\n" (List.length gpx.waypoints);
187
+
Printf.printf "Tracks: %d\n" (List.length gpx.tracks);
188
+
(* Check coordinate ranges *)
189
+
let check_coords () =
190
+
match gpx.waypoints with
191
+
| wpt1 :: wpt2 :: wpt3 :: _ ->
192
+
Printf.printf "South pole coords: %.1f, %.1f\n"
193
+
(latitude_to_float wpt1.lat) (longitude_to_float wpt1.lon);
194
+
Printf.printf "North pole coords: %.1f, %.6f\n"
195
+
(latitude_to_float wpt2.lat) (longitude_to_float wpt2.lon);
196
+
Printf.printf "Null island coords: %.1f, %.1f\n"
197
+
(latitude_to_float wpt3.lat) (longitude_to_float wpt3.lon);
198
+
| _ -> Printf.printf "Unexpected waypoint count\n"
199
+
in
200
+
check_coords ();
201
+
[%expect {|
202
+
Edge cases parsed successfully
203
+
Waypoints: 3
204
+
Tracks: 1
205
+
South pole coords: -90.0, -180.0
206
+
North pole coords: 90.0, 180.000000
207
+
Null island coords: 0.0, 0.0 |}]
208
+
| Error _ ->
209
+
Printf.printf "Parse error\n";
210
+
[%expect.unreachable]
211
+
212
+
let%expect_test "test validation" =
213
+
let content = read_test_file "comprehensive.gpx" in
214
+
match parse_string content with
215
+
| Ok gpx ->
216
+
let validation = validate_gpx gpx in
217
+
Printf.printf "Is valid: %b\n" validation.is_valid;
218
+
Printf.printf "Issue count: %d\n" (List.length validation.issues);
219
+
[%expect {|
220
+
Is valid: true
221
+
Issue count: 0 |}]
222
+
| Error _ ->
223
+
Printf.printf "Parse error\n";
224
+
[%expect.unreachable]
225
+
226
+
let%expect_test "round-trip test" =
227
+
let content = read_test_file "simple_waypoints.gpx" in
228
+
match parse_string content with
229
+
| Ok gpx ->
230
+
(match write_string gpx with
231
+
| Ok xml_output ->
232
+
(match parse_string xml_output with
233
+
| Ok gpx2 ->
234
+
Printf.printf "Round-trip successful\n";
235
+
Printf.printf "Original waypoints: %d\n" (List.length gpx.waypoints);
236
+
Printf.printf "Round-trip waypoints: %d\n" (List.length gpx2.waypoints);
237
+
Printf.printf "Creators match: %b\n" (gpx.creator = gpx2.creator);
238
+
[%expect {|
239
+
Round-trip successful
240
+
Original waypoints: 3
241
+
Round-trip waypoints: 3
242
+
Creators match: true |}]
243
+
| Error _ ->
244
+
Printf.printf "Round-trip parse failed\n";
245
+
[%expect.unreachable])
246
+
| Error _ ->
247
+
Printf.printf "Write failed\n";
248
+
[%expect.unreachable])
249
+
| Error _ ->
250
+
Printf.printf "Initial parse failed\n";
251
+
[%expect.unreachable]
+272
test/test_corpus_unix_eio.ml
+272
test/test_corpus_unix_eio.ml
···
1
+
(** Alcotest suite comparing Unix and Eio implementations *)
2
+
3
+
open Alcotest
4
+
5
+
let test_data_dir = "test/data"
6
+
7
+
let test_files = [
8
+
"simple_waypoints.gpx";
9
+
"detailed_waypoints.gpx";
10
+
"simple_route.gpx";
11
+
"simple_track.gpx";
12
+
"multi_segment_track.gpx";
13
+
"comprehensive.gpx";
14
+
"minimal.gpx";
15
+
"edge_cases.gpx";
16
+
]
17
+
18
+
(** Helper to compare GPX documents *)
19
+
let compare_gpx_basic gpx1 gpx2 =
20
+
let open Gpx in
21
+
gpx1.creator = gpx2.creator &&
22
+
List.length gpx1.waypoints = List.length gpx2.waypoints &&
23
+
List.length gpx1.routes = List.length gpx2.routes &&
24
+
List.length gpx1.tracks = List.length gpx2.tracks
25
+
26
+
(** Test Unix implementation can read all test files *)
27
+
let test_unix_parsing filename () =
28
+
let path = Filename.concat test_data_dir filename in
29
+
match Gpx_unix.read path with
30
+
| Ok gpx ->
31
+
let validation = Gpx.validate_gpx gpx in
32
+
check bool "GPX is valid" true validation.is_valid;
33
+
check bool "Has some content" true (
34
+
List.length gpx.waypoints > 0 ||
35
+
List.length gpx.routes > 0 ||
36
+
List.length gpx.tracks > 0
37
+
)
38
+
| Error err ->
39
+
failf "Unix parsing failed for %s: %s" filename
40
+
(match err with
41
+
| Gpx.Invalid_xml s -> "Invalid XML: " ^ s
42
+
| Gpx.Invalid_coordinate s -> "Invalid coordinate: " ^ s
43
+
| Gpx.Missing_required_attribute (elem, attr) ->
44
+
Printf.sprintf "Missing attribute %s in %s" attr elem
45
+
| Gpx.Missing_required_element s -> "Missing element: " ^ s
46
+
| Gpx.Validation_error s -> "Validation error: " ^ s
47
+
| Gpx.Xml_error s -> "XML error: " ^ s
48
+
| Gpx.IO_error s -> "I/O error: " ^ s)
49
+
50
+
(** Test Eio implementation can read all test files *)
51
+
let test_eio_parsing filename () =
52
+
Eio_main.run @@ fun env ->
53
+
let fs = Eio.Stdenv.fs env in
54
+
let path = Filename.concat test_data_dir filename in
55
+
try
56
+
let gpx = Gpx_eio.read ~fs path in
57
+
let validation = Gpx.validate_gpx gpx in
58
+
check bool "GPX is valid" true validation.is_valid;
59
+
check bool "Has some content" true (
60
+
List.length gpx.waypoints > 0 ||
61
+
List.length gpx.routes > 0 ||
62
+
List.length gpx.tracks > 0
63
+
)
64
+
with
65
+
| Gpx.Gpx_error err ->
66
+
failf "Eio parsing failed for %s: %s" filename
67
+
(match err with
68
+
| Gpx.Invalid_xml s -> "Invalid XML: " ^ s
69
+
| Gpx.Invalid_coordinate s -> "Invalid coordinate: " ^ s
70
+
| Gpx.Missing_required_attribute (elem, attr) ->
71
+
Printf.sprintf "Missing attribute %s in %s" attr elem
72
+
| Gpx.Missing_required_element s -> "Missing element: " ^ s
73
+
| Gpx.Validation_error s -> "Validation error: " ^ s
74
+
| Gpx.Xml_error s -> "XML error: " ^ s
75
+
| Gpx.IO_error s -> "I/O error: " ^ s)
76
+
77
+
(** Test Unix and Eio implementations produce equivalent results *)
78
+
let test_unix_eio_equivalence filename () =
79
+
let path = Filename.concat test_data_dir filename in
80
+
81
+
(* Parse with Unix *)
82
+
let unix_result = Gpx_unix.read path in
83
+
84
+
(* Parse with Eio *)
85
+
let eio_result =
86
+
try
87
+
Eio_main.run @@ fun env ->
88
+
let fs = Eio.Stdenv.fs env in
89
+
Ok (Gpx_eio.read ~fs path)
90
+
with
91
+
| Gpx.Gpx_error err -> Error err
92
+
in
93
+
94
+
match unix_result, eio_result with
95
+
| Ok gpx_unix, Ok gpx_eio ->
96
+
check bool "Unix and Eio produce equivalent results" true
97
+
(compare_gpx_basic gpx_unix gpx_eio);
98
+
check string "Creators match" gpx_unix.creator gpx_eio.creator;
99
+
check int "Waypoint counts match"
100
+
(List.length gpx_unix.waypoints) (List.length gpx_eio.waypoints);
101
+
check int "Route counts match"
102
+
(List.length gpx_unix.routes) (List.length gpx_eio.routes);
103
+
check int "Track counts match"
104
+
(List.length gpx_unix.tracks) (List.length gpx_eio.tracks)
105
+
| Error _, Error _ ->
106
+
(* Both failed - that's consistent *)
107
+
check bool "Both Unix and Eio failed consistently" true true
108
+
| Ok _, Error _ ->
109
+
failf "Unix succeeded but Eio failed for %s" filename
110
+
| Error _, Ok _ ->
111
+
failf "Eio succeeded but Unix failed for %s" filename
112
+
113
+
(** Test write-read round-trip with Unix *)
114
+
let test_unix_round_trip filename () =
115
+
let path = Filename.concat test_data_dir filename in
116
+
match Gpx_unix.read path with
117
+
| Ok gpx_original ->
118
+
(* Write to temporary string *)
119
+
(match Gpx.write_string gpx_original with
120
+
| Ok xml_string ->
121
+
(* Parse the written string *)
122
+
(match Gpx.parse_string xml_string with
123
+
| Ok gpx_roundtrip ->
124
+
check bool "Round-trip preserves basic structure" true
125
+
(compare_gpx_basic gpx_original gpx_roundtrip);
126
+
check string "Creator preserved"
127
+
gpx_original.creator gpx_roundtrip.creator
128
+
| Error _ ->
129
+
failf "Round-trip parse failed for %s" filename)
130
+
| Error _ ->
131
+
failf "Round-trip write failed for %s" filename)
132
+
| Error _ ->
133
+
failf "Initial read failed for %s" filename
134
+
135
+
(** Test write-read round-trip with Eio *)
136
+
let test_eio_round_trip filename () =
137
+
Eio_main.run @@ fun env ->
138
+
let fs = Eio.Stdenv.fs env in
139
+
let path = Filename.concat test_data_dir filename in
140
+
try
141
+
let gpx_original = Gpx_eio.read ~fs path in
142
+
(* Write to temporary string via GPX core *)
143
+
match Gpx.write_string gpx_original with
144
+
| Ok xml_string ->
145
+
(* Parse the written string *)
146
+
(match Gpx.parse_string xml_string with
147
+
| Ok gpx_roundtrip ->
148
+
check bool "Round-trip preserves basic structure" true
149
+
(compare_gpx_basic gpx_original gpx_roundtrip);
150
+
check string "Creator preserved"
151
+
gpx_original.creator gpx_roundtrip.creator
152
+
| Error _ ->
153
+
failf "Round-trip parse failed for %s" filename)
154
+
| Error _ ->
155
+
failf "Round-trip write failed for %s" filename
156
+
with
157
+
| Gpx.Gpx_error _ ->
158
+
failf "Initial read failed for %s" filename
159
+
160
+
(** Test validation works on all files *)
161
+
let test_validation filename () =
162
+
let path = Filename.concat test_data_dir filename in
163
+
match Gpx_unix.read path with
164
+
| Ok gpx ->
165
+
let validation = Gpx.validate_gpx gpx in
166
+
check bool "Validation runs without error" true true;
167
+
(* All our test files should be valid *)
168
+
if filename <> "invalid.gpx" then
169
+
check bool "Test file is valid" true validation.is_valid
170
+
| Error _ ->
171
+
(* Invalid.gpx should fail to parse - this is expected *)
172
+
if filename = "invalid.gpx" then
173
+
check bool "Invalid file correctly fails to parse" true true
174
+
else
175
+
failf "Could not read %s for validation test" filename
176
+
177
+
(** Test error handling with invalid file *)
178
+
let test_error_handling () =
179
+
let path = Filename.concat test_data_dir "invalid.gpx" in
180
+
181
+
(* Test Unix error handling *)
182
+
(match Gpx_unix.read path with
183
+
| Ok _ ->
184
+
failf "Unix should have failed to parse invalid.gpx"
185
+
| Error _ ->
186
+
check bool "Unix correctly rejects invalid file" true true);
187
+
188
+
(* Test Eio error handling *)
189
+
(try
190
+
Eio_main.run @@ fun env ->
191
+
let fs = Eio.Stdenv.fs env in
192
+
let _ = Gpx_eio.read ~fs path in
193
+
failf "Eio should have failed to parse invalid.gpx"
194
+
with
195
+
| Gpx.Gpx_error _ ->
196
+
check bool "Eio correctly rejects invalid file" true true)
197
+
198
+
(** Performance comparison test *)
199
+
let test_performance_comparison filename () =
200
+
let path = Filename.concat test_data_dir filename in
201
+
202
+
(* Time Unix parsing *)
203
+
let start_unix = Sys.time () in
204
+
let _ = Gpx_unix.read path in
205
+
let unix_time = Sys.time () -. start_unix in
206
+
207
+
(* Time Eio parsing *)
208
+
let start_eio = Sys.time () in
209
+
let _ = Eio_main.run @@ fun env ->
210
+
let fs = Eio.Stdenv.fs env in
211
+
try Some (Gpx_eio.read ~fs path)
212
+
with Gpx.Gpx_error _ -> None
213
+
in
214
+
let eio_time = Sys.time () -. start_eio in
215
+
216
+
(* Both should complete reasonably quickly (under 1 second for test files) *)
217
+
check bool "Unix parsing completes quickly" true (unix_time < 1.0);
218
+
check bool "Eio parsing completes quickly" true (eio_time < 1.0);
219
+
220
+
Printf.printf "Performance for %s: Unix=%.3fms, Eio=%.3fms\n"
221
+
filename (unix_time *. 1000.) (eio_time *. 1000.)
222
+
223
+
(** Generate test cases for each file *)
224
+
let make_unix_tests () =
225
+
List.map (fun filename ->
226
+
test_case filename `Quick (test_unix_parsing filename)
227
+
) test_files
228
+
229
+
let make_eio_tests () =
230
+
List.map (fun filename ->
231
+
test_case filename `Quick (test_eio_parsing filename)
232
+
) test_files
233
+
234
+
let make_equivalence_tests () =
235
+
List.map (fun filename ->
236
+
test_case filename `Quick (test_unix_eio_equivalence filename)
237
+
) test_files
238
+
239
+
let make_unix_round_trip_tests () =
240
+
List.map (fun filename ->
241
+
test_case filename `Quick (test_unix_round_trip filename)
242
+
) test_files
243
+
244
+
let make_eio_round_trip_tests () =
245
+
List.map (fun filename ->
246
+
test_case filename `Quick (test_eio_round_trip filename)
247
+
) test_files
248
+
249
+
let make_validation_tests () =
250
+
List.map (fun filename ->
251
+
test_case filename `Quick (test_validation filename)
252
+
) (test_files @ ["invalid.gpx"])
253
+
254
+
let make_performance_tests () =
255
+
List.map (fun filename ->
256
+
test_case filename `Quick (test_performance_comparison filename)
257
+
) test_files
258
+
259
+
(** Main test suite *)
260
+
let () =
261
+
run "GPX Corpus Tests" [
262
+
"Unix parsing", make_unix_tests ();
263
+
"Eio parsing", make_eio_tests ();
264
+
"Unix vs Eio equivalence", make_equivalence_tests ();
265
+
"Unix round-trip", make_unix_round_trip_tests ();
266
+
"Eio round-trip", make_eio_round_trip_tests ();
267
+
"Validation", make_validation_tests ();
268
+
"Error handling", [
269
+
test_case "invalid file handling" `Quick test_error_handling;
270
+
];
271
+
"Performance", make_performance_tests ();
272
+
]
+19
-19
test/test_gpx.ml
+19
-19
test/test_gpx.ml
···
4
4
5
5
let test_coordinate_validation () =
6
6
(* Test valid coordinates *)
7
-
assert (Result.is_ok (Types.latitude 45.0));
8
-
assert (Result.is_ok (Types.longitude (-122.0)));
9
-
assert (Result.is_ok (Types.degrees 180.0));
7
+
assert (Result.is_ok (latitude 45.0));
8
+
assert (Result.is_ok (longitude (-122.0)));
9
+
assert (Result.is_ok (degrees 180.0));
10
10
11
11
(* Test invalid coordinates *)
12
-
assert (Result.is_error (Types.latitude 91.0));
13
-
assert (Result.is_error (Types.longitude 180.0));
14
-
assert (Result.is_error (Types.degrees 360.0));
12
+
assert (Result.is_error (latitude 91.0));
13
+
assert (Result.is_error (longitude 180.0));
14
+
assert (Result.is_error (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
-
assert (Types.fix_type_to_string Types.Fix_2d = "2d");
21
-
assert (Types.fix_type_of_string "3d" = Some Types.Fix_3d);
22
-
assert (Types.fix_type_of_string "invalid" = None);
20
+
assert (fix_type_to_string Fix_2d = "2d");
21
+
assert (fix_type_of_string "3d" = Some Fix_3d);
22
+
assert (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
-
let gpx = Types.make_gpx ~creator in
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 = []);
···
41
41
</wpt>
42
42
</gpx>|} in
43
43
44
-
match Gpx_parser.parse_string gpx_xml with
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);
···
56
56
assert false
57
57
58
58
let test_simple_writing () =
59
-
let lat = Result.get_ok (Types.latitude 37.7749) in
60
-
let lon = Result.get_ok (Types.longitude (-122.4194)) in
61
-
let wpt = { (Types.make_waypoint_data lat lon) with
59
+
let lat = Result.get_ok (latitude 37.7749) in
60
+
let lon = Result.get_ok (longitude (-122.4194)) in
61
+
let wpt = { (make_waypoint_data lat lon) with
62
62
name = Some "Test Point";
63
63
desc = Some "A test waypoint" } in
64
-
let gpx = { (Types.make_gpx ~creator:"test") with
64
+
let gpx = { (make_gpx ~creator:"test") with
65
65
waypoints = [wpt] } in
66
66
67
-
match Writer.write_string gpx with
67
+
match write_string gpx with
68
68
| Ok xml_string ->
69
69
assert (try ignore (String.index xml_string 'T'); true with Not_found -> false);
70
70
assert (try ignore (String.index xml_string '3'); true with Not_found -> false);
···
77
77
assert false
78
78
79
79
let test_validation () =
80
-
let gpx = Types.make_gpx ~creator:"" in
81
-
let validation = Validate.validate_gpx gpx in
80
+
let gpx = make_gpx ~creator:"" in
81
+
let validation = validate_gpx gpx in
82
82
assert (not validation.is_valid);
83
-
let errors = List.filter (fun issue -> issue.Validate.level = `Error) validation.issues in
83
+
let errors = List.filter (fun issue -> issue.level = `Error) validation.issues in
84
84
assert (List.length errors > 0);
85
85
86
86
Printf.printf "✓ Validation tests passed\n"