open Yaxpo

type xml_callbacks =
    {
      start_element : (qname -> att list -> (unit->unit) -> unit);
      characters : (string -> (unit->unit) -> unit);
      cdata : (string -> (unit->unit) -> unit);
      comment : (string -> (unit->unit) -> unit);
      pi : (string -> string -> (unit->unit) -> unit);
      end_element : (qname -> (unit->unit) -> unit);
    }

let rec parse_element (reader:#Cps_reader.t) callbacks (k:(unit->unit)) =
  pull_next_token reader
    (function
	 Tok_start_tag(name,atts) -> 
	   callbacks.start_element name atts (fun () -> parse_rest_of_element reader callbacks name k)
       | Tok_empty_ele(name,atts) ->
	   callbacks.start_element name atts (fun () -> callbacks.end_element name k)
       | _ as bogus -> raise (Parse_error ("Unexpected token",(Some bogus))))
and parse_rest_of_element reader callbacks name (k:(unit->unit)) =
  let krec = (fun () -> parse_rest_of_element reader callbacks name k) in
    pull_next_token reader
      (function
	   Tok_text(s) -> callbacks.characters s krec
	 | Tok_start_tag(sub_name,atts) -> (* this is the heart of the CPS descent. *)
	     callbacks.start_element sub_name atts
	     (fun () -> parse_rest_of_element reader callbacks (**) sub_name (**) krec)
	 | Tok_empty_ele(name,atts) ->
	     callbacks.start_element name atts (fun () -> callbacks.end_element name krec)
	 | Tok_end_tag(end_name) when end_name = name -> callbacks.end_element name k
	 | Tok_end_tag(bogus) as tok -> raise (Parse_error (("Expected close tag for " ^ (string_of_qname name)),Some tok))
	 | Tok_comment(s) -> callbacks.comment s krec
	 | Tok_pi(target,s) -> callbacks.pi target s krec
	 | Tok_cdata(s) -> callbacks.cdata s krec)

let rec parse_document (reader:#Cps_reader.t) callbacks (k:(unit->unit)) =
let krec = (fun () -> parse_document reader callbacks k) in
  pull_next_token reader
    (function
	 Tok_pi(target,s) -> callbacks.pi target s krec
       | Tok_comment(s) -> callbacks.comment s krec
       | Tok_start_tag(name,atts) -> (* document element *)
	   callbacks.start_element name atts
	   (fun () -> parse_rest_of_element reader callbacks name k)
       | Tok_empty_ele(name,atts) ->
	   callbacks.start_element name atts
	   (fun () ->
	      callbacks.end_element name k)
       | _ as bogus -> raise (Parse_error ("unexpected token",Some bogus)))