type event = Open of string * (string * string) list | Close of string | Text of string

let eq_event e1 e2 =
  match e1, e2 with
  | Open(t1, l1), Open(t2, l2) -> t1 = t2 &&
  let sl1 = List.sort compare l1
  and sl2 = List.sort compare l2 in sl1 = sl2
  | Close t1, Close t2 -> t1 = t2
  | Text s1 , Text s2 -> s1 = s2
  | _ -> false


type position = {
  byte_index : int;
  column_num : int;
  line_num : int;
  byte_count : int;
}

type ctx = {
  text_buffer : Buffer.t;
  events : (event*position) Queue.t;
}
let get_position p =
  { byte_index = Expat.get_current_byte_index p;
    column_num = Expat.get_current_column_number p;
    line_num =  Expat.get_current_line_number p;
    byte_count =  Expat.get_current_byte_count p;
  }


let rec start_element_handler parser_ ctx tag attr_list =
  do_text parser_ ctx;
  Queue.add (Open(tag, attr_list), get_position parser_) ctx.events

and end_element_handler parser_ ctx tag =
  do_text parser_ ctx;
  Queue.add (Close(tag), get_position parser_) ctx.events

and do_text parser_ ctx =
  if Buffer.length ctx.text_buffer != 0 then
    let s = Buffer.contents ctx.text_buffer in
    Buffer.clear  ctx.text_buffer;
    Queue.add (Text s, get_position parser_) ctx.events

let character_data_handler _ ctx text =
  Buffer.add_string ctx.text_buffer text

let create_parser () =
  let ctx1 = { text_buffer = Buffer.create 512; events = Queue.create (); } in
  let parser1 = Expat.parser_create ~encoding:None in
  Expat.set_start_element_handler parser1 (start_element_handler parser1 ctx1);
  Expat.set_end_element_handler parser1 (end_element_handler parser1 ctx1);
  Expat.set_character_data_handler
    parser1 (character_data_handler parser1 ctx1);
  parser1, ctx1

exception Diff of position

let common_prefix ctx1 ctx2 len =
  for i = 1 to len do
    let e1,p1 = Queue.pop ctx1.events in
    let e2,_ = Queue.pop ctx2.events in
    if not (eq_event e1 e2) then raise (Diff p1)
  done


let diffs fd1 fd2 =
  let buffer1 = String.create 4096 in
  let buffer2 = String.create 4096 in
  let parser1,ctx1 = create_parser () in
  let parser2,ctx2 = create_parser () in
  let rec loop () =
    let read1 = input fd1 buffer1 0 4096 in
    let read2 = input fd2 buffer2 0 4096 in
    if read1 == 0 && read2 == 0 then begin
      let l1 = Queue.length ctx1.events in
      let l2 = Queue.length ctx2.events in
      if l1 > l2 then let _, p1 = Queue.pop ctx1.events in raise (Diff p1)
      else if l2 > l1 then let _, p2 = Queue.pop ctx2.events in raise (Diff p2)
      else common_prefix ctx1 ctx2 l1
    end else begin
      let () = Expat.parse_sub parser1 buffer1 0 read1 in
      let () = Expat.parse_sub parser2 buffer2 0 read2 in
      common_prefix ctx1 ctx2 (min (Queue.length ctx1.events) (Queue.length ctx2.events));
      loop ()
    end
  in
  loop ()

let main () =
  if Array.length Sys.argv != 3 then begin
    Printf.eprintf "usage: %s file1.xml file2.xml\n%!" Sys.argv.(0);
    exit 2
  end else
    let fn1 = Sys.argv.(1) in
    let fn2 = Sys.argv.(2) in
    try
      let fd1 = open_in fn1 in
      let fd2 = open_in fn2 in
      let code =
        try
          diffs fd1 fd2; 0
        with
          Diff p -> Printf.eprintf "File %s and %s differ at line %i, column %i\n%!"
            fn1 fn2 p.line_num p.column_num;1
      in close_in fd1; close_in fd2; exit code
    with
      e -> Printf.eprintf "Error %s\n%!" (Printexc.to_string e); exit 3

let () = main ()