Source file extension.ml

(** Extension mechanism for custom GPX elements *)

(** Main extension type *)
type t = {
  namespace : string option;
  name : string;
  attributes : (string * string) list;
  content : content;
}

(** Content types for extensions *)
and content =
  | Text of string
  | Elements of t list
  | Mixed of string * t list

(** {2 Extension Operations} *)

(** Create extension with flexible content *)
let make ?namespace ~name ~attributes ~content () =
  { namespace; name; attributes; content }

(** Create an extension with text content *)
let make_text ~name ?namespace ?(attributes=[]) text =
  { namespace; name; attributes; content = Text text }

(** Create an extension with element content *)
let make_elements ~name ?namespace ?(attributes=[]) elements =
  { namespace; name; attributes; content = Elements elements }

(** Create an extension with mixed content *)
let make_mixed ~name ?namespace ?(attributes=[]) text elements =
  { namespace; name; attributes; content = Mixed (text, elements) }

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

(** Get optional namespace *)
let namespace t = t.namespace

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

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

(** Create text content *)
let text_content text = Text text

(** Create elements content *)
let elements_content elements = Elements elements

(** Create mixed content *)
let mixed_content text elements = Mixed (text, elements)

(** Find attribute value by name *)
let find_attribute name t =
  List.assoc_opt name t.attributes

(** Add or update attribute *)
let set_attribute name value t =
  let attributes = 
    (name, value) :: List.remove_assoc name t.attributes
  in
  { t with attributes }

(** Compare extensions *)
let rec compare t1 t2 =
  let ns_cmp = Option.compare String.compare t1.namespace t2.namespace in
  if ns_cmp <> 0 then ns_cmp
  else
    let name_cmp = String.compare t1.name t2.name in
    if name_cmp <> 0 then name_cmp
    else
      let attr_cmp = compare_attributes t1.attributes t2.attributes in
      if attr_cmp <> 0 then attr_cmp
      else compare_content t1.content t2.content

and compare_attributes attrs1 attrs2 =
  let sorted1 = List.sort (fun (k1,_) (k2,_) -> String.compare k1 k2) attrs1 in
  let sorted2 = List.sort (fun (k1,_) (k2,_) -> String.compare k1 k2) attrs2 in
  List.compare (fun (k1,v1) (k2,v2) ->
    let k_cmp = String.compare k1 k2 in
    if k_cmp <> 0 then k_cmp else String.compare v1 v2
  ) sorted1 sorted2

and compare_content c1 c2 = match c1, c2 with
  | Text s1, Text s2 -> String.compare s1 s2
  | Elements e1, Elements e2 -> List.compare compare e1 e2
  | Mixed (s1, e1), Mixed (s2, e2) ->
    let s_cmp = String.compare s1 s2 in
    if s_cmp <> 0 then s_cmp else List.compare compare e1 e2
  | Text _, _ -> -1
  | Elements _, Text _ -> 1
  | Elements _, Mixed _ -> -1
  | Mixed _, _ -> 1

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

(** Pretty print extension *)
let rec pp ppf t =
  match t.namespace with
  | Some ns -> Format.fprintf ppf "<%s:%s" ns t.name
  | None -> Format.fprintf ppf "<%s" t.name;
  List.iter (fun (k, v) -> Format.fprintf ppf " %s=\"%s\"" k v) t.attributes;
  match t.content with
  | Text "" -> Format.fprintf ppf "/>"
  | Text text -> Format.fprintf ppf ">%s</%s>" text (qualified_name t)
  | Elements [] -> Format.fprintf ppf "/>"
  | Elements elements ->
    Format.fprintf ppf ">";
    List.iter (Format.fprintf ppf "%a" pp) elements;
    Format.fprintf ppf "</%s>" (qualified_name t)
  | Mixed (text, []) -> Format.fprintf ppf ">%s</%s>" text (qualified_name t)
  | Mixed (text, elements) ->
    Format.fprintf ppf ">%s" text;
    List.iter (Format.fprintf ppf "%a" pp) elements;
    Format.fprintf ppf "</%s>" (qualified_name t)

and qualified_name t =
  match t.namespace with
  | Some ns -> ns ^ ":" ^ t.name
  | None -> t.name

(** {2 Content Operations} *)

(** Check if content is text *)
let is_text_content = function Text _ -> true | _ -> false

(** Check if content is elements *)
let is_elements_content = function Elements _ -> true | _ -> false

(** Check if content is mixed *)
let is_mixed_content = function Mixed _ -> true | _ -> false

(** Extract text content *)
let text_content_extract = function Text s -> Some s | _ -> None

(** Extract element content *)
let elements_content_extract = function Elements e -> Some e | _ -> None

(** Extract mixed content *)
let mixed_content_extract = function Mixed (s, e) -> Some (s, e) | _ -> None