(* path.ml - Don Yang (uguu.org)

   04/16/06
                                                                           *)

(* Path separator.  Always use forward slash, even on Windows.  This is
   because cygwin tools can't deal with backslashes while most windows
   tools can, so forward slash is the lowest common denominator.
   Also, backslash doesn't go well with regular expressions.            *)
let separator = '/';;
let separator_str = String.make 1 separator;;

(* Get last part of a string *)
let string_tail str index =
   String.sub str index ((String.length str) - index);;

(* Modify string in-place, replacing path separator characters to use
   expected separator above.                                          *)
let other_separator = '\\';;
let replace_separator path =
   for i = 0 to ((String.length path) - 1) do
      if (String.get path i) = other_separator then String.set path i separator
   done;;

(* Split path to list of components *)
let rec split_recurse path index limit =
   if index >= limit
   then [path]
   else
      if String.get path index = separator
      then
         let remaining = limit - index - 1 in
            (String.sub path 0 index) ::
            (split_recurse
               (String.sub path (index + 1) remaining) 0 remaining)
      else split_recurse path (index + 1) limit;;

let split_to_parts path =
   split_recurse path 0 (String.length path);;

(* Join list of path components to a single string *)
let rec join_recurse part_list =
   match part_list
   with a::[] -> a
   | a::b -> a ^ separator_str ^ (join_recurse b)
   | [] -> "";;

let join_parts part_list =
   join_recurse part_list;;

(* Normalize a single path string, removing . and .. components.
   List of path components to keep is maintained as a reversed list
   for better memory management.                                    *)
let rec normalize_recurse rev_keep_parts path_parts =
   match path_parts
   with "."::b -> (normalize_recurse rev_keep_parts b)
   | ".."::b ->
      (match rev_keep_parts
         with ""::y | ".."::y -> (normalize_recurse (".."::rev_keep_parts) b)
         | x::y -> normalize_recurse y b
         | [] -> (normalize_recurse [".."] b))
   | ""::b -> (normalize_recurse rev_keep_parts b)
   | a::b -> (normalize_recurse (a::rev_keep_parts) b)
   | [] -> List.rev rev_keep_parts;;

let normalize path =
   replace_separator path;
   let root =
      try
         if String.get path 0 = separator then separator_str else ""
      with Invalid_argument _ -> "" in
   root ^ (join_parts (normalize_recurse [] (split_to_parts path)));;

(* Replace parent directory *)
let replace_root src_root dst_root path =
   try
      let root_len = (String.length src_root) + 1 in
      let root = String.sub path 0 root_len in
      if root <> (src_root ^ separator_str)
      then ""
      else dst_root ^ separator_str ^ (string_tail path root_len)
   with Invalid_argument _ -> "";;

(* Convert absolute path to relative path *)
let rec remove_common_root path1_parts path2_parts =
   match path1_parts with a1::b1 ->
      (match path2_parts with a2::b2 ->
       if a1 = a2 then remove_common_root b1 b2 else (path1_parts, path2_parts)
       | [] -> (path1_parts, path2_parts))
   | [] -> (path1_parts, path2_parts);;

let rec add_relative_prefix depth =
   if depth > 0 then ".."::(add_relative_prefix (depth - 1)) else [];;

let relative cwd path =
   let (src, dst) =
      remove_common_root (split_to_parts cwd) (split_to_parts path) in
   join_parts ((add_relative_prefix (List.length src)) @ dst);;

(* Check if string contains ... pattern *)
let rec contains_subdir_pattern str =
   try
      let s = String.index str '.' in
      if String.sub str s 3 = "..."
      then true
      else contains_subdir_pattern (string_tail str (s + 1))
   with Not_found | Invalid_argument _ -> false;;

(* Convert string containing only * wildcard to regular expression *)
let rec convert_dir_pattern str =
   try
      let s = String.index str '*' in
      (Str.quote (String.sub str 0 s)) ^
      "[^" ^ separator_str ^ "]*" ^
      (convert_dir_pattern (string_tail str (s + 1)))
   with Not_found -> Str.quote str;;

(* Convert string containing only ... wildcard to regular expression *)
let rec convert_subdir_pattern str =
   try
      let s = String.index str '.' in
      if String.sub str s 3 = "..."
      then
         (Str.quote (String.sub str 0 s)) ^
         ".*" ^
         (convert_subdir_pattern (string_tail str (s + 3)))
      else
         (Str.quote (String.sub str 0 (s + 1))) ^
         (convert_subdir_pattern (string_tail str (s + 1)))
   with Not_found | Invalid_argument _ -> Str.quote str;;

(* Convert string containing both * and ... to regular expression *)
let rec convert_mixed_pattern str =
   if str = "" then "" else
   let h = String.get str 0 in
   match h
   with '*' ->
      "[^" ^ separator_str ^ "]*" ^
      (convert_mixed_pattern (string_tail str 1))
   | '.' ->
      if String.length str >= 3 then
         (if String.sub str 0 3 = "..."
          then ".*" ^ (convert_mixed_pattern (string_tail str 3))
          else "\\." ^ (convert_mixed_pattern (string_tail str 1)))
      else
         (Str.quote (String.make 1 h)) ^
         (convert_mixed_pattern (string_tail str 1))
   | _ ->
      (Str.quote (String.make 1 h)) ^
      (convert_mixed_pattern (string_tail str 1));;

(* Build regular expression string to match path pattern *)
type dir_enum_type = BASE_DIR | SUB_DIR | SINGLE_FILE;;
let pattern_to_regexp pattern =
   if String.contains pattern '*'
   then
      if contains_subdir_pattern pattern
      then (convert_mixed_pattern pattern, SUB_DIR)
      else (convert_dir_pattern pattern, BASE_DIR)
   else
      if contains_subdir_pattern pattern
      then (convert_subdir_pattern pattern, SUB_DIR)
      else (Str.quote pattern, SINGLE_FILE);;