(** GPX validation utilities *) (** Validation error messages *) type validation_issue = { level : [`Error | `Warning]; message : string; location : string option; } type validation_result = { issues : validation_issue list; is_valid : bool; } let make_error ?location message = { level = `Error; message; location; } let make_warning ?location message = { level = `Warning; message; location; } (** Validate waypoint data *) let validate_waypoint_data wpt location = let issues = ref [] in (* Check for negative satellite count *) (match Waypoint.sat wpt with | Some sat when sat < 0 -> issues := make_warning ~location ("Negative satellite count: " ^ string_of_int sat) :: !issues | _ -> ()); (* Check for unreasonable precision values *) let check_precision name value = match value with | Some v when v < 0.0 -> issues := make_warning ~location (Printf.sprintf "Negative %s value: %.2f" name v) :: !issues | Some v when v > 1000.0 -> issues := make_warning ~location (Printf.sprintf "Very large %s value: %.2f" name v) :: !issues | _ -> () in check_precision "hdop" (Waypoint.hdop wpt); check_precision "vdop" (Waypoint.vdop wpt); check_precision "pdop" (Waypoint.pdop wpt); (* Check elevation reasonableness *) (match Waypoint.elevation wpt with | Some ele when ele < -15000.0 -> issues := make_warning ~location (Printf.sprintf "Very low elevation: %.2f m" ele) :: !issues | Some ele when ele > 15000.0 -> issues := make_warning ~location (Printf.sprintf "Very high elevation: %.2f m" ele) :: !issues | _ -> ()); (* Check DGPS age *) (match Waypoint.ageofdgpsdata wpt with | Some age when age < 0.0 -> issues := make_error ~location "Negative DGPS age" :: !issues | _ -> ()); !issues (** Validate bounds *) let validate_bounds bounds = let issues = ref [] in let location = "bounds" in let (minlat, minlon, maxlat, maxlon) = Metadata.Bounds.bounds bounds in if Coordinate.latitude_to_float minlat >= Coordinate.latitude_to_float maxlat then issues := make_error ~location "minlat must be less than maxlat" :: !issues; if Coordinate.longitude_to_float minlon >= Coordinate.longitude_to_float maxlon then issues := make_error ~location "minlon must be less than maxlon" :: !issues; !issues (** Validate metadata *) let validate_metadata metadata = let issues = ref [] in (* Validate bounds if present *) (match Metadata.bounds_opt metadata with | Some bounds -> issues := validate_bounds bounds @ !issues | None -> ()); (* Check for reasonable copyright year *) (match Metadata.copyright metadata with | Some copyright -> (match Link.copyright_year copyright with | Some year when year < 1900 || year > 2100 -> issues := make_warning ~location:"metadata.copyright" (Printf.sprintf "Unusual copyright year: %d" year) :: !issues | _ -> ()) | None -> ()); !issues (** Validate route *) let validate_route route = let issues = ref [] in let location = "route" in (* Check for empty route *) let points = Route.points route in if points = [] then issues := make_warning ~location "Route has no points" :: !issues; (* Validate route points *) List.iteri (fun i rtept -> let point_location = Printf.sprintf "route.rtept[%d]" i in issues := validate_waypoint_data rtept point_location @ !issues ) points; !issues (** Validate track segment *) let validate_track_segment trkseg seg_idx = let issues = ref [] in let location = Printf.sprintf "track.trkseg[%d]" seg_idx in (* Check for empty segment *) let points = Track.Segment.points trkseg in if points = [] then issues := make_warning ~location "Track segment has no points" :: !issues; (* Validate track points *) List.iteri (fun i trkpt -> let point_location = Printf.sprintf "%s.trkpt[%d]" location i in issues := validate_waypoint_data trkpt point_location @ !issues ) points; (* Check for time ordering if timestamps are present *) let rec check_time_order prev_time = function | [] -> () | trkpt :: rest -> (match (prev_time, Waypoint.time trkpt) with | (Some prev, Some curr) when Ptime.compare prev curr > 0 -> issues := make_warning ~location "Track points not in chronological order" :: !issues | _ -> ()); check_time_order (Waypoint.time trkpt) rest in check_time_order None points; !issues (** Validate track *) let validate_track track = let issues = ref [] in let location = "track" in (* Check for empty track *) let segments = Track.segments track in if segments = [] then issues := make_warning ~location "Track has no segments" :: !issues; (* Validate track segments *) List.iteri (fun i trkseg -> issues := validate_track_segment trkseg i @ !issues ) segments; !issues (** Validate complete GPX document *) let validate_gpx gpx = let issues = ref [] in (* Check GPX version *) let version = Doc.version gpx in if version <> "1.0" && version <> "1.1" then issues := make_error ~location:"gpx" (Printf.sprintf "Unsupported GPX version: %s (supported: 1.0, 1.1)" version) :: !issues else if version = "1.0" then issues := make_warning ~location:"gpx" "GPX 1.0 detected - consider upgrading to GPX 1.1 for better compatibility" :: !issues; (* Check for empty creator *) let creator = Doc.creator gpx in if String.trim creator = "" then issues := make_error ~location:"gpx" "Creator cannot be empty" :: !issues; (* Validate metadata *) (match Doc.metadata gpx with | Some metadata -> issues := validate_metadata metadata @ !issues | None -> ()); (* Validate waypoints *) let waypoints = Doc.waypoints gpx in List.iteri (fun i wpt -> let location = Printf.sprintf "waypoint[%d]" i in issues := validate_waypoint_data wpt location @ !issues ) waypoints; (* Validate routes *) let routes = Doc.routes gpx in List.iteri (fun _i route -> issues := validate_route route @ !issues ) routes; (* Validate tracks *) let tracks = Doc.tracks gpx in List.iteri (fun _i track -> issues := validate_track track @ !issues ) tracks; (* Check for completely empty GPX *) if waypoints = [] && routes = [] && tracks = [] then issues := make_warning ~location:"gpx" "GPX document contains no geographic data" :: !issues; let all_issues = !issues in let has_errors = List.exists (fun issue -> issue.level = `Error) all_issues in { issues = all_issues; is_valid = not has_errors } (** Quick validation - returns true if document is valid *) let is_valid gpx = let result = validate_gpx gpx in result.is_valid (** Get only error messages *) let errors gpx = let result = validate_gpx gpx in List.filter (fun issue -> issue.level = `Error) result.issues (** Get only warning messages *) let warnings gpx = let result = validate_gpx gpx in List.filter (fun issue -> issue.level = `Warning) result.issues (** Format validation issue for display *) let format_issue issue = let level_str = match issue.level with | `Error -> "ERROR" | `Warning -> "WARNING" in let location_str = match issue.location with | Some loc -> " at " ^ loc | None -> "" in Printf.sprintf "%s%s: %s" level_str location_str issue.message