helm/ocaml/getter/tree.ml

   1 (* to avoid the need of -rectypes *)
   2 type tree = Foo of (string * tree) list
   3
   4 let rec add_path t l =
   5   match l with
   6   | [] -> t (* no more path to add *)
   7   | name::tl -> add_path_aux t name tl
   8
   9 and add_path_aux t name tl =
  10   match t with
  11   | Foo [] -> Foo [(name, add_path (Foo []) tl)]
  12   | Foo ((n, t')::bro) when n = name -> Foo ((n, (add_path t' tl))::bro)
  13   | Foo (((n, t') as x)::bro) ->
  14       let tmp = add_path_aux (Foo bro) name tl in
  15       match tmp with Foo y -> Foo (x::y)
  16
  17 let rec get_frontier t l =
  18   match l with
  19   | [] -> (match t with Foo bla ->
  20             List.map (function (x,Foo []) -> x | (x,_) -> (x^"/")) bla)
  21   | name::tl -> get_frontier_aux t name tl
  22
  23 and get_frontier_aux (t:tree) name tl =
  24   match t with
  25   | Foo [] -> []
  26   | Foo ((n, t')::bro) when Pcre.pmatch ~pat:("^" ^ name ^ "$") n ->
  27       (* since regex are no more "unique" matches, we have to continue
  28        * searching on the brothers.
  29        *)
  30       get_frontier t' tl @ get_frontier_aux (Foo bro) name tl
  31   | Foo (_::bro) -> get_frontier_aux (Foo bro) name tl
  32
  33 let rec remove_path t path =
  34   match path with
  35   | [] -> t
  36   | name::tl -> remove_path_aux t name tl
  37
  38 and remove_path_aux t name tl =
  39   match t with
  40   | Foo [] -> assert false
  41   | Foo ((n, t')::bro) when n = name ->
  42       let tmp = remove_path t' tl in
  43       (match tmp with
  44       | Foo [] -> Foo bro
  45       | Foo x -> Foo ((n, Foo x)::bro))
  46   | Foo (((n, t') as x)::bro) ->
  47       let tmp = remove_path_aux (Foo bro) name tl in
  48       match tmp with Foo y -> Foo (x::y)
  49
  50 let split_RE = Pcre.regexp "/"
  51
  52 let empty_tree = Foo []
  53
  54 let add_uri suri t =
  55   let s = (Pcre.split ~rex:split_RE suri) in
  56   add_path t s
  57
  58 let ls_path path t =
  59   let s = (Pcre.split ~rex:split_RE path) in
  60   get_frontier t s
  61
  62 let remove_uri suri t =
  63   let s = (Pcre.split ~rex:split_RE suri) in
  64   remove_path t s
  65
  66 let save_to_disk path t =
  67   let o = open_out path in
  68   Marshal.to_channel o t [];
  69   close_out o
  70
  71 let load_from_disk path =
  72   let i = open_in path in
  73   let t = Marshal.from_channel i in
  74   close_in i;
  75   t
  76