hphp/hack/src/utils/relative_path.ml

   1 (**
   2  * Copyright (c) 2014, Facebook, Inc.
   3  * All rights reserved.
   4  *
   5  * This source code is licensed under the BSD-style license found in the
   6  * LICENSE file in the "hack" directory of this source tree. An additional grant
   7  * of patent rights can be found in the PATENTS file in the same directory.
   8  *
   9  *)
  10
  11 open Utils
  12
  13 type prefix =
  14   | Root
  15   | Hhi
  16   | Dummy
  17
  18 let root = ref None
  19 let hhi = ref None
  20
  21 let path_ref_of_prefix = function
  22   | Root -> root
  23   | Hhi -> hhi
  24   | Dummy -> ref (Some "")
  25
  26 let path_of_prefix x =
  27   unsafe_opt_note "Prefix has not been set!" !(path_ref_of_prefix x)
  28
  29 let string_of_prefix = function
  30   | Root -> "root"
  31   | Hhi -> "hhi"
  32   | Dummy -> ""
  33
  34 let set_path_prefix prefix v =
  35   let v = Path.to_string v in
  36   assert (String.length v > 0);
  37   (* Ensure that there is a trailing slash *)
  38   let v =
  39     if str_ends_with v Filename.dir_sep then v
  40     else v ^ Filename.dir_sep
  41   in
  42   match prefix with
  43   | Dummy -> raise (Failure "Dummy is always represented by an empty string")
  44   | _ -> path_ref_of_prefix prefix := Some v
  45
  46 type t = prefix * string
  47
  48 let prefix (p : t) = fst p
  49
  50 let suffix (p : t) = snd p
  51
  52 let default = (Dummy, "")
  53
  54 module S = struct
  55   type path = t
  56   type t = path
  57
  58   let compare = Pervasives.compare
  59
  60   (* We could have simply used Marshal.to_string here, but this does slightly
  61    * better on space usage. *)
  62   let to_string (p, rest) = string_of_prefix p ^ "|" ^ rest
  63 end
  64
  65 module Set = Set.Make(S)
  66 module Map = Utils.MyMap(S)
  67
  68 let to_absolute (p, rest) = path_of_prefix p ^ rest
  69
  70 let create prefix s =
  71   let prefix_s = path_of_prefix prefix in
  72   let prefix_len = String.length prefix_s in
  73   if not (str_starts_with s prefix_s)
  74   then raise (Failure (Printf.sprintf "%s is not a prefix of %s" prefix_s s));
  75   prefix, String.sub s prefix_len (String.length s - prefix_len)
  76
  77 let concat prefix s = prefix, s
  78
  79 let relativize_set prefix m =
  80   SSet.fold (fun k a -> Set.add (create prefix k) a) m Set.empty