ocamlspot / filepath.ml

(***********************************************************************)
(*                                                                     *)
(*                            OCamlSpotter                             *)
(*                                                                     *)
(*                             Jun FURUSE                              *)
(*                                                                     *)
(*   Copyright 2008-2012 Jun Furuse. All rights reserved.              *)
(*   This file is distributed under the terms of the GNU Library       *)
(*   General Public License, with the special exception on linking     *)
(*   described in file LICENSE.                                        *)
(*                                                                     *)
(***********************************************************************)

(* File path normalization *)

open Utils

module F = Filename

let get_component : string -> string = 
  Hashtbl.memoize (Hashtbl.create 1023) (fun x -> x)

let dotdot = get_component ".."

let rec split st path = 
  let dir  = F.dirname  path in
  let base = F.basename path in
  let st = 
    let base = 
      if base = ""
      || base = F.current_dir_name 
      || base = F.dir_sep || base = "/" then ""
      else base
    in
    get_component base :: st
  in
  if dir = F.current_dir_name then false, st
  else if dir = F.dir_sep || dir = "/" then true, st
  else split st dir

let split = split []
      
let () = 
  match Sys.os_type with
  | "Unix" -> 
      assert (split ""       = (false, [""]));
      assert (split "."      = (false, [""]));
      assert (split "/"      = (true, [""]));
      assert (split "/."     = (true, [""]));
      assert (split "./"     = (false, [""]));
      assert (split ".."     = (false, [".."]));
      assert (split "/.."    = (true, [".."]));
      assert (split "/.."    = (true, [".."]));
      assert (split "//"     = (true, [""]));
      assert (split "///"    = (true, [""]));
      assert (split "a/"     = (false, ["a"]));
      assert (split "a/."    = (false, ["a"; ""]));
      assert (split "a/b"    = (false, ["a"; "b"]));
      assert (split "a/b/"   = (false, ["a"; "b"]));
      assert (split "a/b/."  = (false, ["a"; "b"; ""]));
      assert (split "a//b/." = (false, ["a"; "b"; ""]))
  | _ -> ()

let rec rev_normalize rev abs = function
  | [] -> rev
  | x::xs ->
      if x = F.dir_sep || x = F.current_dir_name then assert false;
      if x = F.parent_dir_name then
        match rev with
        | [] -> rev_normalize (if abs then [] else [F.parent_dir_name]) abs xs
        | r::_ when r = F.parent_dir_name -> rev_normalize (x::rev) abs xs
        | _::rs -> rev_normalize rs abs xs
      else if x = "" then rev_normalize rev abs xs
      else rev_normalize (x::rev) abs xs
      
let hashcons_list = 
  let cache = Hashtbl.create 1023 in
  let rec f xs = Hashtbl.memoize cache (function
    | [] -> []
    | x::xs -> x :: f xs) xs
  in
  f

let rev_normalize rev abs xs = hashcons_list (rev_normalize rev abs xs)

let () = 
  assert (rev_normalize [] false [] = []);
  assert (rev_normalize [] false [""] = []);
  assert (rev_normalize [] false [""; ""] = []);
  assert (rev_normalize [] false ["a"; ""] = ["a"]);
  assert (rev_normalize [] false [""; "a"] = ["a"]);
  assert (rev_normalize [] false ["a"; ""] == rev_normalize [] false [""; "a"]);
  assert (rev_normalize [] false ["a"; ".."] = []);
  assert (rev_normalize [] false ["a"; ".."; "b"] = ["b"]);
  assert (rev_normalize [] false [".."; "a"] = ["a"; ".."]);
  assert (rev_normalize [] false [".."; "a"; ".."] = [".."]);
  assert (rev_normalize [] false [".."; "a"; "b"; ".."; ".."; "c"] = ["c"; ".."]);
  assert (rev_normalize [] false [".."; "a"; ".."; ".."; "c"] = ["c"; ".."; ".."]);
  assert (rev_normalize [] true  [".."; "a"] = ["a"]);
  assert (rev_normalize [] true  [".."; "a"; ".."] = []);
  assert (rev_normalize [] true  [".."; "a"; "b"; ".."; ".."; "c"] = ["c"]);
  assert (rev_normalize [] true  [".."; "a"; ".."; ".."; "c"] = ["c"]);

type t = bool * string list

let equal (b1,xs1) (b2,xs2) = b1 = b2 && xs1 == xs2

let compare t1 t2 = if equal t1 t2 then 0 else compare t1 t2

let of_string path = 
  let abs, xs = split path in
  abs, rev_normalize [] abs xs

let to_string (abs, rev) =
  let xs = List.rev rev in
  let xs = if abs then "" :: xs else xs in
  if xs = [] then "." else String.concat (F.dir_sep) xs

let is_absolute (abs, _) = abs
let is_relative (abs, _) = not abs

let root = (true, [])
let is_root = function 
  | (true, []) -> true
  | _ -> false

let dirbase (abs, xs) = match xs with
  | [] | ".." :: _ -> (abs, xs), None
  | x::xs -> (abs, xs), Some x

let (^/) (abs, xs) s = 
  let abs', ys = split s in
  assert (not abs');
  abs, rev_normalize xs abs ys

let parent = function
  | (false, (".."::_ | [] as xs)) -> (false, dotdot :: xs)
  | (true, []) -> (true, [])
  | (abs, (_::xs)) -> (abs, xs)
Tip: Filter by directory path e.g. /media app.js to search for public/media/app.js.
Tip: Use camelCasing e.g. ProjME to search for ProjectModifiedEvent.java.
Tip: Filter by extension type e.g. /repo .js to search for all .js files in the /repo directory.
Tip: Separate your search with spaces e.g. /ssh pom.xml to search for src/ssh/pom.xml.
Tip: Use ↑ and ↓ arrow keys to navigate and return to view the file.
Tip: You can also navigate files with Ctrl+j (next) and Ctrl+k (previous) and view the file with Ctrl+o.
Tip: You can also navigate files with Alt+j (next) and Alt+k (previous) and view the file with Alt+o.