Source file validate.ml

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