Interpret jbuild-ignore files sooner
Interpret then while loading the file tree.
This commit is contained in:
parent
c28ee8fa10
commit
7a5698c7b1
|
@ -603,14 +603,14 @@ let dump_trace t = Trace.dump t.trace
|
|||
|
||||
let create ~contexts ~file_tree ~rules =
|
||||
let all_source_files =
|
||||
File_tree.fold file_tree ~init:Pset.empty ~f:(fun dir acc ->
|
||||
let path = File_tree.Dir.path dir in
|
||||
Cont
|
||||
(Pset.union acc
|
||||
(File_tree.Dir.files dir
|
||||
|> String_set.elements
|
||||
|> List.map ~f:(Path.relative path)
|
||||
|> Pset.of_list)))
|
||||
File_tree.fold file_tree ~init:Pset.empty ~traverse_ignored_dirs:true
|
||||
~f:(fun dir acc ->
|
||||
let path = File_tree.Dir.path dir in
|
||||
Pset.union acc
|
||||
(File_tree.Dir.files dir
|
||||
|> String_set.elements
|
||||
|> List.map ~f:(Path.relative path)
|
||||
|> Pset.of_list))
|
||||
in
|
||||
let all_copy_targets =
|
||||
List.fold_left contexts ~init:Pset.empty ~f:(fun acc (ctx : Context.t) ->
|
||||
|
|
|
@ -1,31 +1,25 @@
|
|||
open! Import
|
||||
|
||||
type 'a fold_callback_result =
|
||||
| Cont of 'a
|
||||
| Dont_recurse_in of String_set.t * 'a
|
||||
|
||||
module Dir = struct
|
||||
type t =
|
||||
{ path : Path.t
|
||||
; files : String_set.t
|
||||
; sub_dirs : t String_map.t
|
||||
; ignored : bool
|
||||
}
|
||||
|
||||
let path t = t.path
|
||||
let files t = t.files
|
||||
let sub_dirs t = t.sub_dirs
|
||||
let ignored t = t.ignored
|
||||
|
||||
let rec fold t ~init ~f =
|
||||
match f t init with
|
||||
| Cont init ->
|
||||
String_map.fold t.sub_dirs ~init ~f:(fun ~key:_ ~data:t acc ->
|
||||
fold t ~init:acc ~f)
|
||||
| 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)
|
||||
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
|
||||
String_map.fold t.sub_dirs ~init:acc ~f:(fun ~key:_ ~data:t acc ->
|
||||
fold t ~traverse_ignored_dirs ~init:acc ~f)
|
||||
end
|
||||
|
||||
type t =
|
||||
|
@ -41,37 +35,54 @@ let ignore_file fn ~is_directory =
|
|||
(fn.[0] = '.' && fn.[1] = '#')
|
||||
|
||||
let load path =
|
||||
let rec walk path : Dir.t =
|
||||
let rec walk path ~ignored : Dir.t =
|
||||
let files, sub_dirs =
|
||||
Path.readdir path
|
||||
|> List.filter_map ~f:(fun fn ->
|
||||
let path = Path.relative path fn in
|
||||
let is_directory = Path.exists path && Path.is_directory path in
|
||||
let is_directory =
|
||||
try Path.is_directory path with _ -> false
|
||||
in
|
||||
if ignore_file fn ~is_directory then
|
||||
None
|
||||
else if is_directory then
|
||||
Some (Inr (fn, path))
|
||||
else
|
||||
Some (fn, path, is_directory))
|
||||
|> List.partition_map ~f:(fun (fn, path, is_directory) ->
|
||||
if is_directory then
|
||||
Inr (fn, walk path)
|
||||
else
|
||||
Inl fn)
|
||||
Some (Inl fn))
|
||||
|> List.partition_map ~f:(fun x -> x)
|
||||
in
|
||||
let files = String_set.of_list files in
|
||||
let ignored_sub_dirs =
|
||||
if not ignored && String_set.mem "jbuild-ignore" files then
|
||||
String_set.of_list
|
||||
(Io.lines_of_file (Path.to_string (Path.relative path "jbuild-ignore")))
|
||||
else
|
||||
String_set.empty
|
||||
in
|
||||
let sub_dirs =
|
||||
List.map sub_dirs ~f:(fun (fn, path) ->
|
||||
let ignored = ignored || String_set.mem fn ignored_sub_dirs in
|
||||
(fn, walk path ~ignored))
|
||||
|> String_map.of_alist_exn
|
||||
in
|
||||
{ path
|
||||
; files = String_set.of_list files
|
||||
; sub_dirs = String_map.of_alist_exn sub_dirs
|
||||
; files
|
||||
; sub_dirs
|
||||
; ignored
|
||||
}
|
||||
in
|
||||
let root = walk path in
|
||||
let root = walk path ~ignored:false in
|
||||
let dirs =
|
||||
Dir.fold root ~init:Path.Map.empty ~f:(fun dir acc ->
|
||||
Cont (Path.Map.add acc ~key:dir.path ~data:dir))
|
||||
Dir.fold root ~init:Path.Map.empty ~traverse_ignored_dirs:true
|
||||
~f:(fun dir acc ->
|
||||
Path.Map.add acc ~key:dir.path ~data:dir)
|
||||
in
|
||||
{ root
|
||||
; dirs
|
||||
}
|
||||
|
||||
let fold t ~init ~f = Dir.fold t.root ~init ~f
|
||||
let fold t ~traverse_ignored_dirs ~init ~f =
|
||||
Dir.fold t.root ~traverse_ignored_dirs ~init ~f
|
||||
|
||||
let find_dir t path =
|
||||
Path.Map.find path t.dirs
|
||||
|
@ -89,8 +100,8 @@ 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
|
||||
Cont
|
||||
(String_set.fold (Dir.files dir) ~init:acc ~f:(fun fn acc ->
|
||||
Path.Set.add (Path.relative path fn) acc)))
|
||||
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
|
||||
String_set.fold (Dir.files dir) ~init:acc ~f:(fun fn acc ->
|
||||
Path.Set.add (Path.relative path fn) acc))
|
||||
|
|
|
@ -1,23 +1,27 @@
|
|||
open! Import
|
||||
|
||||
|
||||
module Dir : sig
|
||||
type t
|
||||
|
||||
val path : t -> Path.t
|
||||
val files : t -> String_set.t
|
||||
val sub_dirs : t -> t String_map.t
|
||||
|
||||
(** Whether this directory is ignored by a [jbuild-ignore] file in
|
||||
one of its ancestor directories. *)
|
||||
val ignored : t -> bool
|
||||
end
|
||||
|
||||
type t
|
||||
|
||||
val load : Path.t -> t
|
||||
|
||||
type 'a fold_callback_result =
|
||||
| Cont of 'a
|
||||
| Dont_recurse_in of String_set.t * 'a
|
||||
|
||||
val fold : t -> init:'a -> f:(Dir.t -> 'a -> 'a fold_callback_result) -> 'a
|
||||
val fold
|
||||
: t
|
||||
-> traverse_ignored_dirs:bool
|
||||
-> init:'a
|
||||
-> f:(Dir.t -> 'a -> 'a)
|
||||
-> 'a
|
||||
|
||||
val root : t -> Dir.t
|
||||
|
||||
|
|
|
@ -166,39 +166,25 @@ let load ~dir ~scope =
|
|||
|
||||
let load ?(extra_ignored_subtrees=Path.Set.empty) () =
|
||||
let ftree = File_tree.load Path.root in
|
||||
let packages, ignored_subtrees =
|
||||
File_tree.fold ftree ~init:([], extra_ignored_subtrees) ~f:(fun dir (pkgs, ignored) ->
|
||||
let packages =
|
||||
File_tree.fold ftree ~traverse_ignored_dirs:false ~init:[] ~f:(fun dir pkgs ->
|
||||
let path = File_tree.Dir.path dir in
|
||||
let files = File_tree.Dir.files dir in
|
||||
let pkgs =
|
||||
String_set.fold files ~init:pkgs ~f:(fun fn acc ->
|
||||
match Filename.split_extension fn with
|
||||
| (pkg, ".opam") when pkg <> "" ->
|
||||
let version_from_opam_file =
|
||||
let opam = Opam_file.load (Path.relative path fn |> Path.to_string) in
|
||||
match Opam_file.get_field opam "version" with
|
||||
| Some (String (_, s)) -> Some s
|
||||
| _ -> None
|
||||
in
|
||||
(pkg,
|
||||
{ Package. name = pkg
|
||||
; path
|
||||
; version_from_opam_file
|
||||
}) :: acc
|
||||
| _ -> acc)
|
||||
in
|
||||
if String_set.mem "jbuild-ignore" files then
|
||||
let ignore_set =
|
||||
String_set.of_list
|
||||
(Io.lines_of_file (Path.to_string (Path.relative path "jbuild-ignore")))
|
||||
in
|
||||
Dont_recurse_in
|
||||
(ignore_set,
|
||||
(pkgs,
|
||||
String_set.fold ignore_set ~init:ignored ~f:(fun fn acc ->
|
||||
Path.Set.add (Path.relative path fn) acc)))
|
||||
else
|
||||
Cont (pkgs, ignored))
|
||||
String_set.fold files ~init:pkgs ~f:(fun fn acc ->
|
||||
match Filename.split_extension fn with
|
||||
| (pkg, ".opam") when pkg <> "" ->
|
||||
let version_from_opam_file =
|
||||
let opam = Opam_file.load (Path.relative path fn |> Path.to_string) in
|
||||
match Opam_file.get_field opam "version" with
|
||||
| Some (String (_, s)) -> Some s
|
||||
| _ -> None
|
||||
in
|
||||
(pkg,
|
||||
{ Package. name = pkg
|
||||
; path
|
||||
; version_from_opam_file
|
||||
}) :: acc
|
||||
| _ -> acc))
|
||||
in
|
||||
let packages =
|
||||
String_map.of_alist_multi packages
|
||||
|
@ -219,30 +205,36 @@ let load ?(extra_ignored_subtrees=Path.Set.empty) () =
|
|||
|> Path.Map.map ~f:Scope.make
|
||||
in
|
||||
let rec walk dir jbuilds scope =
|
||||
let path = File_tree.Dir.path dir in
|
||||
let files = File_tree.Dir.files dir in
|
||||
let sub_dirs = File_tree.Dir.sub_dirs dir in
|
||||
let scope = Path.Map.find_default path scopes ~default:scope in
|
||||
let jbuilds =
|
||||
if String_set.mem "jbuild" files then
|
||||
let jbuild = load ~dir:path ~scope in
|
||||
jbuild :: jbuilds
|
||||
else
|
||||
jbuilds
|
||||
in
|
||||
let children, jbuilds =
|
||||
String_map.fold sub_dirs ~init:([], jbuilds)
|
||||
~f:(fun ~key:_ ~data:dir (children, jbuilds) ->
|
||||
if Path.Set.mem (File_tree.Dir.path dir) ignored_subtrees then
|
||||
(children, jbuilds)
|
||||
else
|
||||
let child, jbuilds = walk dir jbuilds scope in
|
||||
(child :: children, jbuilds))
|
||||
in
|
||||
(Alias.Node (path, children), jbuilds)
|
||||
if File_tree.Dir.ignored dir ||
|
||||
Path.Set.mem (File_tree.Dir.path dir) extra_ignored_subtrees then
|
||||
None
|
||||
else begin
|
||||
let path = File_tree.Dir.path dir in
|
||||
let files = File_tree.Dir.files dir in
|
||||
let sub_dirs = File_tree.Dir.sub_dirs dir in
|
||||
let scope = Path.Map.find_default path scopes ~default:scope in
|
||||
let jbuilds =
|
||||
if String_set.mem "jbuild" files then
|
||||
let jbuild = load ~dir:path ~scope in
|
||||
jbuild :: jbuilds
|
||||
else
|
||||
jbuilds
|
||||
in
|
||||
let children, jbuilds =
|
||||
String_map.fold sub_dirs ~init:([], jbuilds)
|
||||
~f:(fun ~key:_ ~data:dir (children, jbuilds) ->
|
||||
match walk dir jbuilds scope with
|
||||
| None -> (children, jbuilds)
|
||||
| Some (child, jbuilds) -> (child :: children, jbuilds))
|
||||
in
|
||||
Some (Alias.Node (path, children), jbuilds)
|
||||
end
|
||||
in
|
||||
let root = File_tree.root ftree in
|
||||
let tree, jbuilds = walk root [] Scope.empty in
|
||||
let tree, jbuilds =
|
||||
Option.value (walk root [] Scope.empty)
|
||||
~default:(Alias.Node (File_tree.Dir.path root, []), [])
|
||||
in
|
||||
{ file_tree = ftree
|
||||
; tree
|
||||
; jbuilds
|
||||
|
|
Loading…
Reference in New Issue