···
+
(** GPX XML writer with complete spec coverage *)
(** Result binding operators *)
···
| Some text -> output_text_element writer name text
+
let output_optional_float_element writer name = function
+
| Some value -> output_text_element writer name (Printf.sprintf "%.6f" value)
+
let output_optional_degrees_element writer name = function
+
| Some degrees -> output_text_element writer name (Printf.sprintf "%.6f" (Coordinate.degrees_to_float degrees))
+
let output_optional_int_element writer name = function
+
| Some value -> output_text_element writer name (string_of_int value)
+
let output_optional_time_element writer name = function
+
| Some time -> output_text_element writer name (Ptime.to_rfc3339 time)
+
let output_optional_fix_element writer name = function
+
| Some fix_type -> output_text_element writer name (Waypoint.fix_type_to_string fix_type)
+
(** Write link elements *)
+
let output_link writer link =
+
let href = Link.href link in
+
let attrs = [(("", "href"), href)] in
+
let* () = output_element_start writer "link" attrs in
+
let* () = output_optional_text_element writer "text" (Link.text link) in
+
let* () = output_optional_text_element writer "type" (Link.type_ link) in
+
output_element_end writer
+
let output_links writer links =
+
let rec write_links = function
+
let* () = output_link writer link in
+
(** Write person (author) element *)
+
let output_person writer person =
+
let* () = output_element_start writer "author" [] in
+
let* () = output_optional_text_element writer "name" (Link.person_name person) in
+
let* () = match Link.person_email person with
+
(* Parse email into id and domain *)
+
(match String.index_opt email '@' with
+
let id = String.sub email 0 at_pos in
+
let domain = String.sub email (at_pos + 1) (String.length email - at_pos - 1) in
+
let attrs = [(("", "id"), id); (("", "domain"), domain)] in
+
let* () = output_element_start writer "email" attrs in
+
output_element_end writer
+
(* Invalid email format, skip *)
+
let* () = match Link.person_link person with
+
| Some link -> output_link writer link
+
output_element_end writer
+
(** Write copyright element *)
+
let output_copyright writer copyright =
+
let author = Link.copyright_author copyright in
+
let attrs = [(("", "author"), author)] in
+
let* () = output_element_start writer "copyright" attrs in
+
let* () = output_optional_int_element writer "year" (Link.copyright_year copyright) in
+
let* () = output_optional_text_element writer "license" (Link.copyright_license copyright) in
+
output_element_end writer
+
(** Write bounds element *)
+
let output_bounds writer bounds =
+
let (minlat, minlon, maxlat, maxlon) = Metadata.Bounds.bounds bounds in
+
(("", "minlat"), Printf.sprintf "%.6f" (Coordinate.latitude_to_float minlat));
+
(("", "minlon"), Printf.sprintf "%.6f" (Coordinate.longitude_to_float minlon));
+
(("", "maxlat"), Printf.sprintf "%.6f" (Coordinate.latitude_to_float maxlat));
+
(("", "maxlon"), Printf.sprintf "%.6f" (Coordinate.longitude_to_float maxlon));
+
let* () = output_element_start writer "bounds" attrs in
+
output_element_end writer
+
(** Write extensions element *)
+
let output_extensions writer extensions =
+
if extensions = [] then Ok ()
+
let* () = output_element_start writer "extensions" [] in
+
(* For now, skip writing extension content - would need full extension serialization *)
+
output_element_end writer
+
(** Write metadata element *)
+
let output_metadata writer metadata =
+
let* () = output_element_start writer "metadata" [] in
+
let* () = output_optional_text_element writer "name" (Metadata.name metadata) in
+
let* () = output_optional_text_element writer "desc" (Metadata.description metadata) in
+
let* () = match Metadata.author metadata with
+
| Some author -> output_person writer author
+
let* () = match Metadata.copyright metadata with
+
| Some copyright -> output_copyright writer copyright
+
let* () = output_links writer (Metadata.links metadata) in
+
let* () = output_optional_time_element writer "time" (Metadata.time metadata) in
+
let* () = output_optional_text_element writer "keywords" (Metadata.keywords metadata) in
+
let* () = match Metadata.bounds_opt metadata with
+
| Some bounds -> output_bounds writer bounds
+
let* () = output_extensions writer (Metadata.extensions metadata) in
+
output_element_end writer
+
(** Write waypoint elements (used for wpt, rtept, trkpt) *)
+
let output_waypoint_data writer waypoint =
+
let* () = output_optional_float_element writer "ele" (Waypoint.elevation waypoint) in
+
let* () = output_optional_time_element writer "time" (Waypoint.time waypoint) in
+
let* () = output_optional_degrees_element writer "magvar" (Waypoint.magvar waypoint) in
+
let* () = output_optional_float_element writer "geoidheight" (Waypoint.geoidheight waypoint) in
+
let* () = output_optional_text_element writer "name" (Waypoint.name waypoint) in
+
let* () = output_optional_text_element writer "cmt" (Waypoint.comment waypoint) in
+
let* () = output_optional_text_element writer "desc" (Waypoint.description waypoint) in
+
let* () = output_optional_text_element writer "src" (Waypoint.source waypoint) in
+
let* () = output_links writer (Waypoint.links waypoint) in
+
let* () = output_optional_text_element writer "sym" (Waypoint.symbol waypoint) in
+
let* () = output_optional_text_element writer "type" (Waypoint.type_ waypoint) in
+
let* () = output_optional_fix_element writer "fix" (Waypoint.fix waypoint) in
+
let* () = output_optional_int_element writer "sat" (Waypoint.sat waypoint) in
+
let* () = output_optional_float_element writer "hdop" (Waypoint.hdop waypoint) in
+
let* () = output_optional_float_element writer "vdop" (Waypoint.vdop waypoint) in
+
let* () = output_optional_float_element writer "pdop" (Waypoint.pdop waypoint) in
+
let* () = output_optional_float_element writer "ageofdgpsdata" (Waypoint.ageofdgpsdata waypoint) in
+
let* () = output_optional_int_element writer "dgpsid" (Waypoint.dgpsid waypoint) in
+
output_extensions writer (Waypoint.extensions waypoint)
+
let output_waypoints writer waypoints =
+
let rec write_waypoints = function
+
let lat = Coordinate.latitude_to_float (Waypoint.lat wpt) in
+
let lon = Coordinate.longitude_to_float (Waypoint.lon wpt) in
+
(("", "lat"), Printf.sprintf "%.6f" lat);
+
(("", "lon"), Printf.sprintf "%.6f" lon);
+
let* () = output_element_start writer "wpt" attrs in
+
let* () = output_waypoint_data writer wpt in
+
let* () = output_element_end writer in
+
write_waypoints waypoints
+
(** Write route points *)
+
let output_route_points writer points element_name =
+
let rec write_points = function
+
let lat = Coordinate.latitude_to_float (Waypoint.lat pt) in
+
let lon = Coordinate.longitude_to_float (Waypoint.lon pt) in
+
(("", "lat"), Printf.sprintf "%.6f" lat);
+
(("", "lon"), Printf.sprintf "%.6f" lon);
+
let* () = output_element_start writer element_name attrs in
+
let* () = output_waypoint_data writer pt in
+
let* () = output_element_end writer in
+
let output_routes writer routes =
+
let rec write_routes = function
+
let* () = output_element_start writer "rte" [] in
+
let* () = output_optional_text_element writer "name" (Route.name route) in
+
let* () = output_optional_text_element writer "cmt" (Route.comment route) in
+
let* () = output_optional_text_element writer "desc" (Route.description route) in
+
let* () = output_optional_text_element writer "src" (Route.source route) in
+
let* () = output_links writer (Route.links route) in
+
let* () = output_optional_int_element writer "number" (Route.number route) in
+
let* () = output_optional_text_element writer "type" (Route.type_ route) in
+
let* () = output_extensions writer (Route.extensions route) in
+
let* () = output_route_points writer (Route.points route) "rtept" in
+
let* () = output_element_end writer in
+
(** Write track segments *)
+
let output_track_segments writer segments =
+
let rec write_segments = function
+
let* () = output_element_start writer "trkseg" [] in
+
let* () = output_route_points writer (Track.Segment.points seg) "trkpt" in
+
let* () = output_extensions writer (Track.Segment.extensions seg) in
+
let* () = output_element_end writer in
+
write_segments segments
+
let output_tracks writer tracks =
+
let rec write_tracks = function
+
let* () = output_element_start writer "trk" [] in
+
let* () = output_optional_text_element writer "name" (Track.name track) in
+
let* () = output_optional_text_element writer "cmt" (Track.comment track) in
+
let* () = output_optional_text_element writer "desc" (Track.description track) in
+
let* () = output_optional_text_element writer "src" (Track.source track) in
+
let* () = output_links writer (Track.links track) in
+
let* () = output_optional_int_element writer "number" (Track.number track) in
+
let* () = output_optional_text_element writer "type" (Track.type_ track) in
+
let* () = output_extensions writer (Track.extensions track) in
+
let* () = output_track_segments writer (Track.segments track) in
+
let* () = output_element_end writer in
(** Write a complete GPX document *)
let write ?(validate=false) output gpx =
let writer = Xmlm.make_output output in
···
(* Write metadata if present *)
let* () = match Doc.metadata gpx with
+
| Some metadata -> output_metadata writer metadata
+
let* () = output_waypoints writer (Doc.waypoints gpx) in
+
let* () = output_routes writer (Doc.routes gpx) in
+
let* () = output_tracks writer (Doc.tracks gpx) in
+
(* Write root-level extensions *)
+
let* () = output_extensions writer (Doc.extensions gpx) in
output_element_end writer
anil.recoil.org