(* $I1: Unison file synchronizer: src/path.ml $ *)
(* $I2: Last modified by vouillon on Wed, 17 Apr 2002 12:03:26 -0400 $ *)
(* $I3: Copyright 1999-2002 (see COPYING for details) $ *)

(* Defines an abstract type of relative pathnames *)

type t = string

let pathSeparatorChar = '/'
let pathSeparatorString = "/"

let concat p p' =
  let l = String.length p in
  if l = 0 then p' else
  let l' = String.length p' in
  if l' = 0 then p else
  let p'' = String.create (l + l' + 1) in
  String.blit p 0 p'' 0 l;
  p''.[l] <- pathSeparatorChar;
  String.blit p' 0 p'' (l + 1) l';
  p''

let empty = ""

let isEmpty p = p = ""

let length p =
  let l = ref 0 in
  for i = 0 to String.length p - 1 do
    if p.[i] = pathSeparatorChar then incr l
  done;
  !l

(* Add a name to the end of a path *)
let rcons n path = concat (Name.toString n) path

let toStringList p = Str.split (Str.regexp pathSeparatorString) p

(* Give a left-to-right list of names in the path *)
let toNames p = List.map Name.fromString (toStringList p)

let child path name = concat path (Name.toString name)

let addSuffixToFinalName path suffix = path ^ suffix

let addPrefixToFinalName path prefix =
  try
    let i = String.rindex path pathSeparatorChar + 1 in
    let l = String.length path in
    let l' = String.length prefix in
    let p = String.create (l + l') in
    String.blit path 0 p 0 i;
    String.blit prefix 0 p i l';
    String.blit path i p (i + l') (l - i);
    p
  with Not_found ->
    assert (not (isEmpty path));
    prefix ^ path

let finalName path =
  try
    let i = String.rindex path pathSeparatorChar + 1 in
    Some (Name.fromString (String.sub path i (String.length path - i)))
  with Not_found ->
    if isEmpty path then
      None
    else
      Some (Name.fromString path)

let parent path =
  let i = String.rindex path pathSeparatorChar in
  String.sub path 0 i

(* pathDeconstruct : path -> (name * path) option *)
let deconstruct path =
  try
    let i = String.index path pathSeparatorChar in
    Some (Name.fromString (String.sub path 0 i),
          String.sub path (i + 1) (String.length path - i - 1))
  with Not_found ->
    if isEmpty path then
      None
    else
      Some (Name.fromString path, empty)

let deconstructRev path =
  try
    let i = String.rindex path pathSeparatorChar in
    Some (Name.fromString
            (String.sub path (i + 1) (String.length path - i - 1)),
          String.sub path 0 i)
  with Not_found ->
    if path = "" then
      None
    else
      Some (Name.fromString path, empty)

let winAbspathRx = Rx.rx "([a-zA-Z]:)?(/|\\\\).*"
let unixAbspathRx = Rx.rx "/.*"
let is_absolute s =
  if Util.osType=`Win32 then Rx.match_string winAbspathRx s
  else Rx.match_string unixAbspathRx s

(* Function string2path: string -> path

   THIS IS THE CRITICAL FUNCTION.

   Problem: What to do on argument "" ?
   What we do: we raise Invalid_argument.

   Problem: double slash within the argument, e.g., "foo//bar".
   What we do: we raise Invalid_argument.

   Problem: What if string2path is applied to an absolute path?  We
   want to disallow this, but, relative is relative.  E.g., on Unix it
   makes sense to have a directory with subdirectory "c:".  Then, it
   makes sense to synchronize on the path "c:".  But this will go
   badly if the Unix system synchronizes with a Windows system.
   What we do: we check whether a path is relative using local
   conventions, and raise Invalid_argument if not.  If we synchronize
   with a system with other conventions, then problems must be caught
   elsewhere.  E.g., the system should refuse to create a directory
   "c:" on a Windows machine.

   Problem: spaces in the argument, e.g., " ".  Still not sure what to
   do here.  Is it possible to create a file with this name in Unix or
   Windows?

   Problem: trailing slashes, e.g., "foo/bar/".  Shells with
   command-line completion may produce these routinely.
   What we do: we remove them.  Moreover, we remove as many as
   necessary, e.g., "foo/bar///" becomes "foo/bar".  This may be
   counter to conventions of some shells/os's, where "foo/bar///"
   might mean "/".

   Examples:
     loop "hello/there" -> ["hello"; "there"]
     loop "/hello/there" -> [""; "hello"; "there"]
     loop "" -> [""]
     loop "/" -> [""; ""]
     loop "//" -> [""; ""; ""]
     loop "c:/" ->["c:"; ""]
     loop "c:/foo" -> ["c:"; "foo"]
*)
let fromString str =
  let str = if Util.osType = `Win32 then Fileutil.bs2fs str else str in
  if is_absolute str then raise(Invalid_argument "Path.fromString");
  let str = Fileutil.removeTrailingSlashes str in
  if str = "" then empty else
  let rec loop p str =
    try
      let pos = String.index str pathSeparatorChar in
      let name1 = String.sub str 0 pos in
      let str_res =
        String.sub str (pos + 1) (String.length str - pos - 1) in
      loop (child p (Name.fromString name1)) str_res
    with
      Not_found -> child p (Name.fromString str)
    | Invalid_argument _ ->
        raise(Invalid_argument "Path.fromString") in
  loop empty str

let toString path = path

let toDebugString path = String.concat " / " (toStringList path)

let compare p1 p2 =
  if Case.insensitive () then Util.nocase_cmp p1 p2 else compare p1 p2

let hash p = Hashtbl.hash p

(* Pref controlling whether symlinks are followed. *)
let follow = Pred.create "follow"
    ("Including the preference \\texttt{-follow \\ARG{pathspec}} causes Unison to \
      treat symbolic links matching \\ARG{pathspec} as `invisible' and \
      behave as if the object pointed to by the link had appeared literally \
      at this position in the replica.  See \
      \\sectionref{symlinks}{Symbolic Links} for more details. \
      The syntax of \\ARG{pathspec>} is \
      described in \\sectionref{pathspec}{Path Specification}.")

let followLink path = Util.osType = `Unix && Pred.test follow (toString path)
