Source file metadata.ml

(** GPX metadata and bounds types *)

(** Bounding box *)
type bounds = {
  minlat : Coordinate.latitude;
  minlon : Coordinate.longitude;
  maxlat : Coordinate.latitude;
  maxlon : Coordinate.longitude;
}

(** Main metadata type *)
type t = {
  name : string option;
  desc : string option;
  author : Link.person option;
  copyright : Link.copyright option;
  links : Link.t list;
  time : Ptime.t option;
  keywords : string option;
  bounds : bounds option;
  extensions : Extension.t list;
}

(** {2 Bounds Operations} *)

module Bounds = struct
  type t = bounds

  (** Create bounds from coordinates *)
  let make ~minlat ~minlon ~maxlat ~maxlon = { minlat; minlon; maxlat; maxlon }

  (** Create bounds from float coordinates with validation *)
  let make_from_floats ~minlat ~minlon ~maxlat ~maxlon =
    match 
      Coordinate.latitude minlat,
      Coordinate.longitude minlon, 
      Coordinate.latitude maxlat,
      Coordinate.longitude maxlon
    with
    | Ok minlat, Ok minlon, Ok maxlat, Ok maxlon ->
      if Coordinate.latitude_to_float minlat <= Coordinate.latitude_to_float maxlat &&
         Coordinate.longitude_to_float minlon <= Coordinate.longitude_to_float maxlon
      then Ok { minlat; minlon; maxlat; maxlon }
      else Error "Invalid bounds: min values must be <= max values"
    | Error e, _, _, _ | _, Error e, _, _ | _, _, Error e, _ | _, _, _, Error e -> Error e

  (** Get corner coordinates *)
  let min_coords t = Coordinate.make t.minlat t.minlon
  let max_coords t = Coordinate.make t.maxlat t.maxlon

  (** Get all bounds as tuple *)
  let bounds t = (t.minlat, t.minlon, t.maxlat, t.maxlon)

  (** Check if coordinate is within bounds *)
  let contains bounds coord =
    let lat = Coordinate.lat coord in
    let lon = Coordinate.lon coord in
    Coordinate.latitude_to_float bounds.minlat <= Coordinate.latitude_to_float lat &&
    Coordinate.latitude_to_float lat <= Coordinate.latitude_to_float bounds.maxlat &&
    Coordinate.longitude_to_float bounds.minlon <= Coordinate.longitude_to_float lon &&
    Coordinate.longitude_to_float lon <= Coordinate.longitude_to_float bounds.maxlon

  (** Calculate bounds area *)
  let area t =
    let lat_diff = Coordinate.latitude_to_float t.maxlat -. Coordinate.latitude_to_float t.minlat in
    let lon_diff = Coordinate.longitude_to_float t.maxlon -. Coordinate.longitude_to_float t.minlon in
    lat_diff *. lon_diff

  (** Compare bounds *)
  let compare t1 t2 =
    let minlat_cmp = Float.compare 
      (Coordinate.latitude_to_float t1.minlat) 
      (Coordinate.latitude_to_float t2.minlat) in
    if minlat_cmp <> 0 then minlat_cmp
    else
      let minlon_cmp = Float.compare 
        (Coordinate.longitude_to_float t1.minlon) 
        (Coordinate.longitude_to_float t2.minlon) in
      if minlon_cmp <> 0 then minlon_cmp
      else
        let maxlat_cmp = Float.compare 
          (Coordinate.latitude_to_float t1.maxlat) 
          (Coordinate.latitude_to_float t2.maxlat) in
        if maxlat_cmp <> 0 then maxlat_cmp
        else Float.compare 
          (Coordinate.longitude_to_float t1.maxlon) 
          (Coordinate.longitude_to_float t2.maxlon)

  (** Test bounds equality *)
  let equal t1 t2 = compare t1 t2 = 0

  (** Pretty print bounds *)
  let pp ppf t =
    Format.fprintf ppf "[(%g,%g) - (%g,%g)]"
      (Coordinate.latitude_to_float t.minlat)
      (Coordinate.longitude_to_float t.minlon)
      (Coordinate.latitude_to_float t.maxlat)
      (Coordinate.longitude_to_float t.maxlon)
end

(** {2 Metadata Operations} *)

(** Create empty metadata *)
let empty = {
  name = None; desc = None; author = None; copyright = None;
  links = []; time = None; keywords = None; bounds = None;
  extensions = [];
}

(** Create metadata with name *)
let make ~name = { empty with name = Some name }

(** Get name *)
let name t = t.name

(** Get description *)  
let description t = t.desc

(** Get author *)
let author t = t.author

(** Get copyright *)
let copyright t = t.copyright

(** Get links *)
let links t = t.links

(** Get time *)
let time t = t.time

(** Get keywords *)
let keywords t = t.keywords

(** Get bounds *)
let bounds_opt t = t.bounds

(** Get extensions *)
let extensions t = t.extensions

(** Update name *)
let with_name t name = { t with name = Some name }

(** Update description *)
let with_description t desc = { t with desc = Some desc }

(** Update keywords *)
let with_keywords t keywords = { t with keywords = Some keywords }

(** Update time *)
let with_time t time = { t with time }

(** Update bounds *)
let with_bounds t bounds = { t with bounds = Some bounds }

(** Update author *)
let with_author t author = { t with author = Some author }

(** Update copyright *)
let with_copyright t copyright = { t with copyright = Some copyright }

(** Add link *)
let add_link t link = { t with links = link :: t.links }

(** Add extensions *)
let add_extensions t extensions = { t with extensions = extensions @ t.extensions }

(** Compare metadata *)
let compare t1 t2 =
  let name_cmp = Option.compare String.compare t1.name t2.name in
  if name_cmp <> 0 then name_cmp
  else
    let desc_cmp = Option.compare String.compare t1.desc t2.desc in
    if desc_cmp <> 0 then desc_cmp
    else Option.compare Ptime.compare t1.time t2.time

(** Test metadata equality *)
let equal t1 t2 = compare t1 t2 = 0

(** Pretty print metadata *)
let pp ppf t =
  match t.name with
  | Some name -> Format.fprintf ppf "\"%s\"" name
  | None -> Format.fprintf ppf "(unnamed)"