2016-12-31 15:12:39 +00:00
|
|
|
open! Import
|
|
|
|
|
2017-03-15 11:41:44 +00:00
|
|
|
type 'a fold_callback_result =
|
|
|
|
| Cont of 'a
|
|
|
|
| Dont_recurse_in of String_set.t * 'a
|
|
|
|
|
2016-12-31 15:12:39 +00:00
|
|
|
module Dir = struct
|
|
|
|
type t =
|
|
|
|
{ path : Path.t
|
|
|
|
; files : String_set.t
|
|
|
|
; sub_dirs : t String_map.t
|
|
|
|
}
|
|
|
|
|
|
|
|
let path t = t.path
|
|
|
|
let files t = t.files
|
|
|
|
let sub_dirs t = t.sub_dirs
|
|
|
|
|
|
|
|
let rec fold t ~init ~f =
|
2017-03-15 11:41:44 +00:00
|
|
|
match f t init with
|
|
|
|
| Cont init ->
|
|
|
|
String_map.fold t.sub_dirs ~init ~f:(fun ~key:_ ~data:t acc ->
|
2016-12-31 15:12:39 +00:00
|
|
|
fold t ~init:acc ~f)
|
2017-03-15 11:41:44 +00:00
|
|
|
| Dont_recurse_in (forbidden, init) ->
|
|
|
|
String_map.fold t.sub_dirs ~init ~f:(fun ~key:sub_dir ~data:t acc ->
|
|
|
|
if String_set.mem sub_dir forbidden then
|
|
|
|
acc
|
|
|
|
else
|
|
|
|
fold t ~init:acc ~f)
|
2016-12-31 15:12:39 +00:00
|
|
|
end
|
|
|
|
|
|
|
|
type t =
|
|
|
|
{ root : Dir.t
|
|
|
|
; dirs : Dir.t Path.Map.t
|
|
|
|
}
|
|
|
|
|
|
|
|
let root t = t.root
|
|
|
|
|
2017-05-19 11:36:06 +00:00
|
|
|
let ignore_file fn ~is_directory =
|
|
|
|
fn = "" || fn = "." ||
|
|
|
|
(is_directory && (fn.[0] = '.' || fn.[0] = '_')) ||
|
|
|
|
(fn.[0] = '.' && fn.[1] = '#')
|
2016-12-31 15:12:39 +00:00
|
|
|
|
|
|
|
let load path =
|
|
|
|
let rec walk path : Dir.t =
|
|
|
|
let files, sub_dirs =
|
|
|
|
Path.readdir path
|
2017-05-19 11:36:06 +00:00
|
|
|
|> List.filter_map ~f:(fun fn ->
|
|
|
|
let path = Path.relative path fn in
|
|
|
|
let is_directory = Path.exists path && Path.is_directory path in
|
|
|
|
if ignore_file fn ~is_directory then
|
|
|
|
None
|
|
|
|
else
|
|
|
|
Some (fn, path, is_directory))
|
|
|
|
|> List.partition_map ~f:(fun (fn, path, is_directory) ->
|
|
|
|
if is_directory then
|
2016-12-31 15:12:39 +00:00
|
|
|
Inr (fn, walk path)
|
|
|
|
else
|
|
|
|
Inl fn)
|
|
|
|
in
|
|
|
|
{ path
|
|
|
|
; files = String_set.of_list files
|
|
|
|
; sub_dirs = String_map.of_alist_exn sub_dirs
|
|
|
|
}
|
|
|
|
in
|
|
|
|
let root = walk path in
|
|
|
|
let dirs =
|
|
|
|
Dir.fold root ~init:Path.Map.empty ~f:(fun dir acc ->
|
2017-03-15 11:41:44 +00:00
|
|
|
Cont (Path.Map.add acc ~key:dir.path ~data:dir))
|
2016-12-31 15:12:39 +00:00
|
|
|
in
|
|
|
|
{ root
|
|
|
|
; dirs
|
|
|
|
}
|
|
|
|
|
2017-03-15 11:41:44 +00:00
|
|
|
let fold t ~init ~f = Dir.fold t.root ~init ~f
|
2016-12-31 15:12:39 +00:00
|
|
|
|
|
|
|
let find_dir t path =
|
|
|
|
Path.Map.find path t.dirs
|
2017-02-23 14:58:18 +00:00
|
|
|
|
|
|
|
let file_exists t path fn =
|
|
|
|
match Path.Map.find path t.dirs with
|
|
|
|
| None -> false
|
|
|
|
| Some { files; _ } -> String_set.mem fn files
|
|
|
|
|
|
|
|
let exists t path =
|
|
|
|
Path.Map.mem path t.dirs ||
|
|
|
|
file_exists t (Path.parent path) (Path.basename path)
|
2017-03-15 09:10:22 +00:00
|
|
|
|
|
|
|
let files_recursively_in t ?(prefix_with=Path.root) path =
|
|
|
|
match find_dir t path with
|
|
|
|
| None -> Path.Set.empty
|
|
|
|
| Some dir ->
|
|
|
|
Dir.fold dir ~init:Path.Set.empty ~f:(fun dir acc ->
|
|
|
|
let path = Path.append prefix_with (Dir.path dir) in
|
2017-03-15 11:41:44 +00:00
|
|
|
Cont
|
|
|
|
(String_set.fold (Dir.files dir) ~init:acc ~f:(fun fn acc ->
|
|
|
|
Path.Set.add (Path.relative path fn) acc)))
|