Up

module Qdom

: sig

XML processing

#
type source_hint
#
module AttrType : sig
#
type t = Xmlm.name
#
val compare : 'a -> 'a -> int
end
#
module AttrMap : sig
#
type t

Maps Xmlm.names to (prefix-hint, value) pairs

#
val empty : t
#
val add : prefix:string -> Xmlm.name -> string -> t -> t

Add a binding with a namespace and suggested prefix.

#
val add_no_ns : string -> string -> t -> t

Add a binding with no namespace (and, therefore, no prefix)

#
val singleton : string -> string -> t

Convenience function to create a map with a single non-namespaced attribute.

#
val get : Xmlm.name -> t -> string option

Get the value of this (namespaced) attribute, as an option.

#
val get_no_ns : string -> t -> string option

Simple wrapper for get for non-namespaced attributes.

#
val remove : Xmlm.name -> t -> t
#
val compare : t -> t -> int

Compare maps, ignoring prefix hints.

#
val mem : Xmlm.name -> t -> bool
#
val add_all : t -> t -> t

add_all overrides old_attrs returns a map with all the bindings of overrides plus all non-conflicting bindings from old_attrs.

#
val iter_values : (Xmlm.name -> string -> unit) -> t -> unit

Iterate over the values (ignoring the prefix hints)

#
val map : (string -> string) -> t -> t

Map attribute values.

end
#
type element = {
# prefix_hint
: string;
# tag
: Xmlm.name;
# attrs
: AttrMap.t;
# child_nodes
: element list;
# text_before
: string;(*The text node immediately before us*)
# last_text_inside
: string;(*The last text node inside us with no following element*)
# source_hint
: source_hint;(*Location to report in error messages*)
}

An XML element node (and nearby text).

Parsing

#
val parse_input : string option -> Xmlm.input -> element

Raises Safe_exception if the XML is not well formed.
#
val parse_file : Common.system -> ?name:string -> string -> element

Load XML from a file.

name : optional name to report in location messages (if missing, uses file name)
Raises Safe_exception if the XML is not well formed.

Helper functions

#
val find : (element -> bool) -> element -> element option

find fn parent returns the first child of parent for which fn child is True.

#
val show_with_loc : element -> string

Generate a string identifying this element for use in error messages. Includes the source location, if known.

#
val raise_elem : ('a, unit, string, element -> 'b) Pervasives.format4 -> 'a

raise_elem "Problem with" elem raises a Safe_exception with the message "Problem with <element> at ..."

#
val log_elem : Logging.level -> ('a, unit, string, element -> unit) Pervasives.format4 -> 'a

Like raise_elem, but writing a log record rather than raising an exception.

#
val simple_content : element -> string

Returns the text content of this element.

Raises Safe_exception if it contains any child nodes.
#
val output : Xmlm.output -> element -> unit

Write out a (sub)tree. e.g. output (Xmlm.make_output @@ `Channel stdout) root

#
val to_utf8 : element -> string

Write a (sub)tree to a string.

#
val compare_nodes : ignore_whitespace:bool -> element -> element -> int

Compare two elements and return -1, 0 or 1. Namespace prefixes, row/column source position and attribute order are ignored.

#
val reindent : element -> element

Add or remove whitespace to indent the document nicely. Nodes with simple content (e.g. <name>Bob</name> do not have their content changed.

#
module type NsType = sig
#
val ns : string
#
val prefix_hint : string
end
#
module NsQuery : functor (Ns : NsType) -> sig
#
val get_attribute : string -> element -> string

Get the value of the non-namespaced attribute attr. Throws an exception if elem isn't in our namespace.

#
val get_attribute_opt : string -> element -> string option
#
val fold_left : ?name:string -> init:'a -> ('a -> element -> 'a) -> element -> 'a
#
val map : ?name:string -> (element -> 'a) -> element -> 'a list

Apply fn to each child node in our namespace with local name name

#
val filter_map : (element -> 'a option) -> element -> 'a list

Apply fn to each child node in our namespace

#
val iter : ?name:string -> (element -> unit) -> element -> unit

Call fn on each child node in our namespace (with name name)

#
val tag : element -> string option

Get the local name of this element, if it's in our namespace.

#
val check_tag : string -> element -> unit

Raises Safe_exception if element does not have the expected name and namespace.
#
val check_ns : element -> unit

Raises Safe_exception if element does not have the expected namespace.
#
val make : ?source_hint:element -> ?attrs:AttrMap.t -> ?child_nodes:element list -> string -> element

Create a new element in our namespace.

source_hint will be used in error messages
end
end