type 'a choice = Left of 'a | Right of 'a

type 'a t = A of string | R of string | E of 'a choice

type absolute = Absolute
type relative = Relative
type either = Either

let to_string = function A s -> s | R s -> s | E (Left s) -> s | E (Right s) -> s

let absrex = Pcre.regexp "^(/(.*[^/][/]*)?)$"
let relrex = Pcre.regexp "^([^/].*[^/])[/]*$"

let mkabs s : absolute t =
  try A (Pcre.extract ~full_match:false ~rex:absrex s).(0)
  with _ -> raise (Failure ("Invalid absolute pathname: " ^ s))

let mkrel s : relative t =
  try R (Pcre.extract ~full_match:false ~rex:relrex s).(0)
  with _ -> raise (Failure ("Invalid relative pathname: " ^ s))

(* There are probably some restrictions we need to impose on s, and
   the same goes for the two functions above. *)
let mkeither s : either t = E s

let of_string s = mkeither s

let concat (a : 'a t) (b : 'b t) : 'c t =
  match a, b with
    A a, R b -> A (a ^ "/" ^ b)
  | R a, R b -> R (a ^ "/" ^ b)
  | _, A b -> A b
  | E (Left a), 
  | R s -> R (s ^ "/" ^ (to_string b))
  | E s -> E (s ^ "/" ^ (to_string b))

(** Similar to My.prefix_length, but treats path elements as units.
  The first slash in a path is a special case, because unlike the
  other slashes, it actually represents a directory, namely the root.
  This contributes to the complexity of this routine. *)
let prefix (p1 : absolute t) (p2 : absolute t) =
  let s1 = to_string p1
  and s2 = to_string p1 in
  let l1 = Pcre.full_split ~pat:"/" s1
  and l2 = Pcre.full_split ~pat:"/" s2 in
  let lst = List2.prefix (=) l1 l2 in
  (* Strip off trailing / *)
  let lst =
    match lst with
      [] -> []
    | [Pcre.Delim "/"] -> lst		(* Preserve plain "/" *)
    | _ ->				(* Strip trailing "/" *)
	let rev = List.rev lst in
	if List.hd rev = Pcre.Delim "/"
	then List.rev (List.tl rev)
	else lst in
  mkabs
    (String.concat ""
       (List.map 
	  (function
	       Pcre.Delim s -> s
	     | Pcre.Text s -> s
	     | _ -> raise (Failure "Unexpected Group"))
	  lst))
  
(* Construct a path from a list of strings, removing double slashes. *) 
let append (lst : string list) =
  mkabs
    (List.fold_left
       (fun path s ->
	  let last = String.length path - 1 in
	  if s = "" then path
	  else if path = "" then s
	  else if path.[last] = '/' && s.[0] = '/'
	  then String.sub path 0 last ^ s
	  else path ^ s)
       "" lst)

let stat path = Unix.LargeFile.stat (to_string path)
let real path = mkabs (Unixutils.realpath (to_string path))
let readlink path = of_string (Unix.readlink (to_string path))
let dirname path = of_string (Filename.dirname (to_string path))