(** 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" text (qualified_name t) | Elements [] -> Format.fprintf ppf "/>" | Elements elements -> Format.fprintf ppf ">"; List.iter (Format.fprintf ppf "%a" pp) elements; Format.fprintf ppf "" (qualified_name t) | Mixed (text, []) -> Format.fprintf ppf ">%s" text (qualified_name t) | Mixed (text, elements) -> Format.fprintf ppf ">%s" text; List.iter (Format.fprintf ppf "%a" pp) elements; Format.fprintf ppf "" (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