2016-12-31 15:12:39 +00:00
|
|
|
open! Import
|
|
|
|
|
|
|
|
module Dir = struct
|
|
|
|
type t =
|
|
|
|
{ path : Path.t
|
2018-04-23 05:08:09 +00:00
|
|
|
; files : String.Set.t
|
2016-12-31 15:12:39 +00:00
|
|
|
; sub_dirs : t String_map.t
|
2017-09-29 13:09:41 +00:00
|
|
|
; ignored : bool
|
2016-12-31 15:12:39 +00:00
|
|
|
}
|
|
|
|
|
|
|
|
let path t = t.path
|
|
|
|
let files t = t.files
|
|
|
|
let sub_dirs t = t.sub_dirs
|
2017-09-29 13:09:41 +00:00
|
|
|
let ignored t = t.ignored
|
2016-12-31 15:12:39 +00:00
|
|
|
|
2018-01-19 08:50:06 +00:00
|
|
|
let file_paths t =
|
|
|
|
Path.Set.of_string_set t.files ~f:(Path.relative t.path)
|
|
|
|
|
|
|
|
let sub_dir_names t =
|
2018-04-23 05:08:09 +00:00
|
|
|
String_map.foldi t.sub_dirs ~init:String.Set.empty
|
|
|
|
~f:(fun s _ acc -> String.Set.add acc s)
|
2018-01-19 08:50:06 +00:00
|
|
|
|
|
|
|
let sub_dir_paths t =
|
2018-02-25 16:35:25 +00:00
|
|
|
String_map.foldi t.sub_dirs ~init:Path.Set.empty
|
|
|
|
~f:(fun s _ acc -> Path.Set.add acc (Path.relative t.path s))
|
2018-01-19 08:50:06 +00:00
|
|
|
|
2017-09-29 13:09:41 +00:00
|
|
|
let rec fold t ~traverse_ignored_dirs ~init:acc ~f =
|
|
|
|
if not traverse_ignored_dirs && t.ignored then
|
|
|
|
acc
|
|
|
|
else
|
|
|
|
let acc = f t acc in
|
2018-02-25 16:35:25 +00:00
|
|
|
String_map.fold t.sub_dirs ~init:acc ~f:(fun t acc ->
|
2017-09-29 13:09:41 +00:00
|
|
|
fold t ~traverse_ignored_dirs ~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
|
|
|
|
2017-09-29 13:27:27 +00:00
|
|
|
let load ?(extra_ignored_subtrees=Path.Set.empty) path =
|
2017-09-29 13:09:41 +00:00
|
|
|
let rec walk path ~ignored : Dir.t =
|
2016-12-31 15:12:39 +00:00
|
|
|
let files, sub_dirs =
|
|
|
|
Path.readdir path
|
2018-02-25 16:35:25 +00:00
|
|
|
|> List.filter_partition_map ~f:(fun fn ->
|
2017-05-19 11:36:06 +00:00
|
|
|
let path = Path.relative path fn in
|
2017-12-21 11:26:52 +00:00
|
|
|
let is_directory = Path.is_directory path in
|
2017-05-19 11:36:06 +00:00
|
|
|
if ignore_file fn ~is_directory then
|
2018-02-25 16:35:25 +00:00
|
|
|
Skip
|
2017-09-29 13:09:41 +00:00
|
|
|
else if is_directory then
|
2018-02-25 16:35:25 +00:00
|
|
|
Right (fn, path)
|
2017-05-19 11:36:06 +00:00
|
|
|
else
|
2018-02-25 16:35:25 +00:00
|
|
|
Left fn)
|
2017-09-29 13:09:41 +00:00
|
|
|
in
|
2018-04-23 05:08:09 +00:00
|
|
|
let files = String.Set.of_list files in
|
2017-09-29 13:09:41 +00:00
|
|
|
let ignored_sub_dirs =
|
2018-04-23 05:08:09 +00:00
|
|
|
if not ignored && String.Set.mem files "jbuild-ignore" then
|
2018-01-23 09:14:22 +00:00
|
|
|
let ignore_file = Path.to_string (Path.relative path "jbuild-ignore") in
|
|
|
|
let files =
|
|
|
|
Io.lines_of_file ignore_file
|
|
|
|
in
|
|
|
|
let remove_subdirs index fn =
|
|
|
|
if Filename.dirname fn = Filename.current_dir_name then
|
|
|
|
true
|
|
|
|
else begin
|
|
|
|
Loc.(warn (of_pos (ignore_file, index + 1, 0, String.length fn))
|
|
|
|
"subdirectory expression %s ignored" fn);
|
|
|
|
false
|
|
|
|
end
|
|
|
|
in
|
2018-04-23 05:08:09 +00:00
|
|
|
String.Set.of_list (List.filteri ~f:remove_subdirs files)
|
2017-09-29 13:09:41 +00:00
|
|
|
else
|
2018-04-23 05:08:09 +00:00
|
|
|
String.Set.empty
|
2017-09-29 13:09:41 +00:00
|
|
|
in
|
|
|
|
let sub_dirs =
|
|
|
|
List.map sub_dirs ~f:(fun (fn, path) ->
|
2017-09-29 13:27:27 +00:00
|
|
|
let ignored =
|
|
|
|
ignored
|
2018-04-23 05:08:09 +00:00
|
|
|
|| String.Set.mem ignored_sub_dirs fn
|
2018-02-25 16:35:25 +00:00
|
|
|
|| Path.Set.mem extra_ignored_subtrees path
|
2017-09-29 13:27:27 +00:00
|
|
|
in
|
2017-09-29 13:09:41 +00:00
|
|
|
(fn, walk path ~ignored))
|
2018-02-25 16:35:25 +00:00
|
|
|
|> String_map.of_list_exn
|
2016-12-31 15:12:39 +00:00
|
|
|
in
|
|
|
|
{ path
|
2017-09-29 13:09:41 +00:00
|
|
|
; files
|
|
|
|
; sub_dirs
|
|
|
|
; ignored
|
2016-12-31 15:12:39 +00:00
|
|
|
}
|
|
|
|
in
|
2017-09-29 13:09:41 +00:00
|
|
|
let root = walk path ~ignored:false in
|
2016-12-31 15:12:39 +00:00
|
|
|
let dirs =
|
2017-09-29 13:09:41 +00:00
|
|
|
Dir.fold root ~init:Path.Map.empty ~traverse_ignored_dirs:true
|
|
|
|
~f:(fun dir acc ->
|
2018-02-25 16:35:25 +00:00
|
|
|
Path.Map.add acc dir.path dir)
|
2016-12-31 15:12:39 +00:00
|
|
|
in
|
|
|
|
{ root
|
|
|
|
; dirs
|
|
|
|
}
|
|
|
|
|
2017-09-29 13:09:41 +00:00
|
|
|
let fold t ~traverse_ignored_dirs ~init ~f =
|
|
|
|
Dir.fold t.root ~traverse_ignored_dirs ~init ~f
|
2016-12-31 15:12:39 +00:00
|
|
|
|
2018-02-25 16:35:25 +00:00
|
|
|
let find_dir t path = Path.Map.find t.dirs path
|
2017-02-23 14:58:18 +00:00
|
|
|
|
2018-01-19 08:50:06 +00:00
|
|
|
let files_of t path =
|
|
|
|
match find_dir t path with
|
|
|
|
| None -> Path.Set.empty
|
|
|
|
| Some dir ->
|
|
|
|
Path.Set.of_string_set (Dir.files dir) ~f:(Path.relative path)
|
|
|
|
|
2017-02-23 14:58:18 +00:00
|
|
|
let file_exists t path fn =
|
2018-02-25 16:35:25 +00:00
|
|
|
match Path.Map.find t.dirs path with
|
2017-02-23 14:58:18 +00:00
|
|
|
| None -> false
|
2018-04-23 05:08:09 +00:00
|
|
|
| Some { files; _ } -> String.Set.mem files fn
|
2017-02-23 14:58:18 +00:00
|
|
|
|
|
|
|
let exists t path =
|
2018-02-25 16:35:25 +00:00
|
|
|
Path.Map.mem t.dirs path ||
|
2017-02-23 14:58:18 +00:00
|
|
|
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 ->
|
2017-09-29 13:09:41 +00:00
|
|
|
Dir.fold dir ~init:Path.Set.empty ~traverse_ignored_dirs:true
|
|
|
|
~f:(fun dir acc ->
|
|
|
|
let path = Path.append prefix_with (Dir.path dir) in
|
2018-04-23 05:08:09 +00:00
|
|
|
String.Set.fold (Dir.files dir) ~init:acc ~f:(fun fn acc ->
|
2018-02-25 16:35:25 +00:00
|
|
|
Path.Set.add acc (Path.relative path fn)))
|