(* Debver *)
(* $Id$ *)

(* version ::=
   | epoch':'.upstream_version.'-'.debian_revision
   | upstream_version_no_colon.'-'.debian_revision
   | upstream_version_no_colon_no_dash
   | epoch':'.upstream_version_no_dash
 * epoch ::= [0-9]+
 * upstream_version ::= [a-zA-Z0-9.+-:]+
 * upstream_version_no_colon ::= [a-zA-Z0-9.+-]+
 * upstream_version_no_dash ::= [a-zA-Z0-9.+:]+
 * upstream_version_no_colon_no_dash ::= [a-zA-Z0-9.+]+
 * debian_revision ::= [a-zA-Z0-9+.]+
 *)

let extract_epoch x =
  try
    let ci = String.index x ':' in
    if ci < String.length x - 1 then
      let epoch = String.sub x 0 ci
      and rest = String.sub x (ci + 1) (String.length x - ci - 1)
      in
      (epoch,rest)
    else
      ("",x)
  with
  | Not_found -> ("",x)
;;

let extract_revision x =
  try
    let di = String.rindex x '-' in
    if di < String.length x - 1 then
      let upstream = String.sub x 0 di
      and revision = String.sub x (di + 1) (String.length x - di - 1)
      in
      (upstream,revision)
    else
      (x,"")
  with
  | Not_found -> (x,"")
;;

let extract_chunks x =
  let (epoch,rest) = extract_epoch x in
  let (upstream,revision) = extract_revision rest in
  (epoch,upstream,revision)
;;

let ( ** ) x y = if x = 0 then y else x;;
let ( *** ) x y = if x = 0 then y () else x;;
let ( ~~~ ) f x = not (f x)

let order = function
  | `C '~' -> (0,'~')
  | `C('0'..'9' as c) -> (1,c)
  | `E -> (2,'\000')
  | `C('a'..'z'|'A'..'Z' as c) -> (3,c)
  | `C(c) -> (4,c)
;;

let compare_couples (x1,x2) (y1,y2) = (compare x1 y1) ** (compare x2 y2);;

let compare_special x y =
  let m = String.length x
  and n = String.length y
  in
  let rec loop i =
    let cx = if i >= m then `E else `C(x.[i])
    and cy = if i >= n then `E else `C(y.[i])
    in
    (compare_couples (order cx) (order cy)) ***
    (fun () ->
      if i > m or i > n then
        0
      else
        loop (i + 1))
  in
  loop 0
;;

(* -1 : x < y *)

let compare_numeric_decimal x y =
  let m = String.length x
  and n = String.length y
  in
  let rec loop1 i j =
    if i = m then
      if j < n then
        loop2 i j
      else
        0
    else
      if j = n then
        loop2 i j
      else
        if x.[i] = y.[j] then loop1 (i + 1) (j + 1)
        else loop2 i j
  and loop2 i j =
    if i = m then
      if j < n then
        -1
      else
        0
    else
      if j = n then
        1
      else
        if m - i < n - j then -1
        else if m - i > n - j then 1
        else
          if x.[i] < y.[j] then -1
          else if x.[i] > y.[j] then 1
          else
              loop2 (i + 1) (j + 1)
  in
  loop1 0 0
;;

let rec compare_chunks x y =
  if x = y then 0
  else
    let x1,x2 = Util.longest_matching_prefix (~~~ Util.is_digit) x
    and y1,y2 = Util.longest_matching_prefix (~~~ Util.is_digit) y
    in
    let c = compare_special x1 y1 in
    if c <> 0 then
      c
    else
      let (x21,x22) = Util.longest_matching_prefix Util.is_digit x2
      and (y21,y22) = Util.longest_matching_prefix Util.is_digit y2
      in
      let c = compare_numeric_decimal x21 y21 in
      if c <> 0 then
        c
      else
        compare_chunks x22 y22
;;

let compare_versions x1 x2 =
  let (e1,u1,r1) = extract_chunks x1
  and (e2,u2,r2) = extract_chunks x2
  in
  (compare_numeric_decimal e1 e2) ***
    (fun () -> (compare_chunks u1 u2) ***
      (fun () -> compare_chunks r1 r2))
;;

let test fn =
  let ic = open_in fn in
  try
    while true do
      let w = input_line ic in
      if w <> "" && w.[0] <> '#' then
        begin
          match Util.split_at ' ' w with
          | [x;y;z] ->
              let z' = int_of_string z in
              let r = compare_versions x y in
              if r = z' then
                Printf.printf "OK %S vs %S gives %d\n" x y r
              else
                Printf.printf "ERROR %S vs %S gives %d should give %d\n" x y r z'
          | _ -> ()
        end;
    done;
    raise End_of_file
  with
  | End_of_file -> close_in ic
;;
