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 create ~contexts ~file_tree ~rules =
|
||||||
let all_source_files =
|
let all_source_files =
|
||||||
File_tree.fold file_tree ~init:Pset.empty ~f:(fun dir acc ->
|
File_tree.fold file_tree ~init:Pset.empty ~traverse_ignored_dirs:true
|
||||||
let path = File_tree.Dir.path dir in
|
~f:(fun dir acc ->
|
||||||
Cont
|
let path = File_tree.Dir.path dir in
|
||||||
(Pset.union acc
|
Pset.union acc
|
||||||
(File_tree.Dir.files dir
|
(File_tree.Dir.files dir
|
||||||
|> String_set.elements
|
|> String_set.elements
|
||||||
|> List.map ~f:(Path.relative path)
|
|> List.map ~f:(Path.relative path)
|
||||||
|> Pset.of_list)))
|
|> Pset.of_list))
|
||||||
in
|
in
|
||||||
let all_copy_targets =
|
let all_copy_targets =
|
||||||
List.fold_left contexts ~init:Pset.empty ~f:(fun acc (ctx : Context.t) ->
|
List.fold_left contexts ~init:Pset.empty ~f:(fun acc (ctx : Context.t) ->
|
||||||
|
|
|
@ -1,31 +1,25 @@
|
||||||
open! Import
|
open! Import
|
||||||
|
|
||||||
type 'a fold_callback_result =
|
|
||||||
| Cont of 'a
|
|
||||||
| Dont_recurse_in of String_set.t * 'a
|
|
||||||
|
|
||||||
module Dir = struct
|
module Dir = struct
|
||||||
type t =
|
type t =
|
||||||
{ path : Path.t
|
{ path : Path.t
|
||||||
; files : String_set.t
|
; files : String_set.t
|
||||||
; sub_dirs : t String_map.t
|
; sub_dirs : t String_map.t
|
||||||
|
; ignored : bool
|
||||||
}
|
}
|
||||||
|
|
||||||
let path t = t.path
|
let path t = t.path
|
||||||
let files t = t.files
|
let files t = t.files
|
||||||
let sub_dirs t = t.sub_dirs
|
let sub_dirs t = t.sub_dirs
|
||||||
|
let ignored t = t.ignored
|
||||||
|
|
||||||
let rec fold t ~init ~f =
|
let rec fold t ~traverse_ignored_dirs ~init:acc ~f =
|
||||||
match f t init with
|
if not traverse_ignored_dirs && t.ignored then
|
||||||
| Cont init ->
|
acc
|
||||||
String_map.fold t.sub_dirs ~init ~f:(fun ~key:_ ~data:t acc ->
|
else
|
||||||
fold t ~init:acc ~f)
|
let acc = f t acc in
|
||||||
| Dont_recurse_in (forbidden, init) ->
|
String_map.fold t.sub_dirs ~init:acc ~f:(fun ~key:_ ~data:t acc ->
|
||||||
String_map.fold t.sub_dirs ~init ~f:(fun ~key:sub_dir ~data:t acc ->
|
fold t ~traverse_ignored_dirs ~init:acc ~f)
|
||||||
if String_set.mem sub_dir forbidden then
|
|
||||||
acc
|
|
||||||
else
|
|
||||||
fold t ~init:acc ~f)
|
|
||||||
end
|
end
|
||||||
|
|
||||||
type t =
|
type t =
|
||||||
|
@ -41,37 +35,54 @@ let ignore_file fn ~is_directory =
|
||||||
(fn.[0] = '.' && fn.[1] = '#')
|
(fn.[0] = '.' && fn.[1] = '#')
|
||||||
|
|
||||||
let load path =
|
let load path =
|
||||||
let rec walk path : Dir.t =
|
let rec walk path ~ignored : Dir.t =
|
||||||
let files, sub_dirs =
|
let files, sub_dirs =
|
||||||
Path.readdir path
|
Path.readdir path
|
||||||
|> List.filter_map ~f:(fun fn ->
|
|> List.filter_map ~f:(fun fn ->
|
||||||
let path = Path.relative path fn in
|
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
|
if ignore_file fn ~is_directory then
|
||||||
None
|
None
|
||||||
|
else if is_directory then
|
||||||
|
Some (Inr (fn, path))
|
||||||
else
|
else
|
||||||
Some (fn, path, is_directory))
|
Some (Inl fn))
|
||||||
|> List.partition_map ~f:(fun (fn, path, is_directory) ->
|
|> List.partition_map ~f:(fun x -> x)
|
||||||
if is_directory then
|
in
|
||||||
Inr (fn, walk path)
|
let files = String_set.of_list files in
|
||||||
else
|
let ignored_sub_dirs =
|
||||||
Inl fn)
|
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
|
in
|
||||||
{ path
|
{ path
|
||||||
; files = String_set.of_list files
|
; files
|
||||||
; sub_dirs = String_map.of_alist_exn sub_dirs
|
; sub_dirs
|
||||||
|
; ignored
|
||||||
}
|
}
|
||||||
in
|
in
|
||||||
let root = walk path in
|
let root = walk path ~ignored:false in
|
||||||
let dirs =
|
let dirs =
|
||||||
Dir.fold root ~init:Path.Map.empty ~f:(fun dir acc ->
|
Dir.fold root ~init:Path.Map.empty ~traverse_ignored_dirs:true
|
||||||
Cont (Path.Map.add acc ~key:dir.path ~data:dir))
|
~f:(fun dir acc ->
|
||||||
|
Path.Map.add acc ~key:dir.path ~data:dir)
|
||||||
in
|
in
|
||||||
{ root
|
{ root
|
||||||
; dirs
|
; 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 =
|
let find_dir t path =
|
||||||
Path.Map.find path t.dirs
|
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
|
match find_dir t path with
|
||||||
| None -> Path.Set.empty
|
| None -> Path.Set.empty
|
||||||
| Some dir ->
|
| Some dir ->
|
||||||
Dir.fold dir ~init:Path.Set.empty ~f:(fun dir acc ->
|
Dir.fold dir ~init:Path.Set.empty ~traverse_ignored_dirs:true
|
||||||
let path = Path.append prefix_with (Dir.path dir) in
|
~f:(fun dir acc ->
|
||||||
Cont
|
let path = Path.append prefix_with (Dir.path dir) in
|
||||||
(String_set.fold (Dir.files dir) ~init:acc ~f:(fun fn acc ->
|
String_set.fold (Dir.files dir) ~init:acc ~f:(fun fn acc ->
|
||||||
Path.Set.add (Path.relative path fn) acc)))
|
Path.Set.add (Path.relative path fn) acc))
|
||||||
|
|
|
@ -1,23 +1,27 @@
|
||||||
open! Import
|
open! Import
|
||||||
|
|
||||||
|
|
||||||
module Dir : sig
|
module Dir : sig
|
||||||
type t
|
type t
|
||||||
|
|
||||||
val path : t -> Path.t
|
val path : t -> Path.t
|
||||||
val files : t -> String_set.t
|
val files : t -> String_set.t
|
||||||
val sub_dirs : t -> t String_map.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
|
end
|
||||||
|
|
||||||
type t
|
type t
|
||||||
|
|
||||||
val load : Path.t -> t
|
val load : Path.t -> t
|
||||||
|
|
||||||
type 'a fold_callback_result =
|
val fold
|
||||||
| Cont of 'a
|
: t
|
||||||
| Dont_recurse_in of String_set.t * 'a
|
-> traverse_ignored_dirs:bool
|
||||||
|
-> init:'a
|
||||||
val fold : t -> init:'a -> f:(Dir.t -> 'a -> 'a fold_callback_result) -> 'a
|
-> f:(Dir.t -> 'a -> 'a)
|
||||||
|
-> 'a
|
||||||
|
|
||||||
val root : t -> Dir.t
|
val root : t -> Dir.t
|
||||||
|
|
||||||
|
|
|
@ -166,39 +166,25 @@ let load ~dir ~scope =
|
||||||
|
|
||||||
let load ?(extra_ignored_subtrees=Path.Set.empty) () =
|
let load ?(extra_ignored_subtrees=Path.Set.empty) () =
|
||||||
let ftree = File_tree.load Path.root in
|
let ftree = File_tree.load Path.root in
|
||||||
let packages, ignored_subtrees =
|
let packages =
|
||||||
File_tree.fold ftree ~init:([], extra_ignored_subtrees) ~f:(fun dir (pkgs, ignored) ->
|
File_tree.fold ftree ~traverse_ignored_dirs:false ~init:[] ~f:(fun dir pkgs ->
|
||||||
let path = File_tree.Dir.path dir in
|
let path = File_tree.Dir.path dir in
|
||||||
let files = File_tree.Dir.files dir in
|
let files = File_tree.Dir.files dir in
|
||||||
let pkgs =
|
String_set.fold files ~init:pkgs ~f:(fun fn acc ->
|
||||||
String_set.fold files ~init:pkgs ~f:(fun fn acc ->
|
match Filename.split_extension fn with
|
||||||
match Filename.split_extension fn with
|
| (pkg, ".opam") when pkg <> "" ->
|
||||||
| (pkg, ".opam") when pkg <> "" ->
|
let version_from_opam_file =
|
||||||
let version_from_opam_file =
|
let opam = Opam_file.load (Path.relative path fn |> Path.to_string) in
|
||||||
let opam = Opam_file.load (Path.relative path fn |> Path.to_string) in
|
match Opam_file.get_field opam "version" with
|
||||||
match Opam_file.get_field opam "version" with
|
| Some (String (_, s)) -> Some s
|
||||||
| Some (String (_, s)) -> Some s
|
| _ -> None
|
||||||
| _ -> None
|
in
|
||||||
in
|
(pkg,
|
||||||
(pkg,
|
{ Package. name = pkg
|
||||||
{ Package. name = pkg
|
; path
|
||||||
; path
|
; version_from_opam_file
|
||||||
; version_from_opam_file
|
}) :: acc
|
||||||
}) :: acc
|
| _ -> 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))
|
|
||||||
in
|
in
|
||||||
let packages =
|
let packages =
|
||||||
String_map.of_alist_multi 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
|
|> Path.Map.map ~f:Scope.make
|
||||||
in
|
in
|
||||||
let rec walk dir jbuilds scope =
|
let rec walk dir jbuilds scope =
|
||||||
let path = File_tree.Dir.path dir in
|
if File_tree.Dir.ignored dir ||
|
||||||
let files = File_tree.Dir.files dir in
|
Path.Set.mem (File_tree.Dir.path dir) extra_ignored_subtrees then
|
||||||
let sub_dirs = File_tree.Dir.sub_dirs dir in
|
None
|
||||||
let scope = Path.Map.find_default path scopes ~default:scope in
|
else begin
|
||||||
let jbuilds =
|
let path = File_tree.Dir.path dir in
|
||||||
if String_set.mem "jbuild" files then
|
let files = File_tree.Dir.files dir in
|
||||||
let jbuild = load ~dir:path ~scope in
|
let sub_dirs = File_tree.Dir.sub_dirs dir in
|
||||||
jbuild :: jbuilds
|
let scope = Path.Map.find_default path scopes ~default:scope in
|
||||||
else
|
let jbuilds =
|
||||||
jbuilds
|
if String_set.mem "jbuild" files then
|
||||||
in
|
let jbuild = load ~dir:path ~scope in
|
||||||
let children, jbuilds =
|
jbuild :: jbuilds
|
||||||
String_map.fold sub_dirs ~init:([], jbuilds)
|
else
|
||||||
~f:(fun ~key:_ ~data:dir (children, jbuilds) ->
|
jbuilds
|
||||||
if Path.Set.mem (File_tree.Dir.path dir) ignored_subtrees then
|
in
|
||||||
(children, jbuilds)
|
let children, jbuilds =
|
||||||
else
|
String_map.fold sub_dirs ~init:([], jbuilds)
|
||||||
let child, jbuilds = walk dir jbuilds scope in
|
~f:(fun ~key:_ ~data:dir (children, jbuilds) ->
|
||||||
(child :: children, jbuilds))
|
match walk dir jbuilds scope with
|
||||||
in
|
| None -> (children, jbuilds)
|
||||||
(Alias.Node (path, children), jbuilds)
|
| Some (child, jbuilds) -> (child :: children, jbuilds))
|
||||||
|
in
|
||||||
|
Some (Alias.Node (path, children), jbuilds)
|
||||||
|
end
|
||||||
in
|
in
|
||||||
let root = File_tree.root ftree 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
|
{ file_tree = ftree
|
||||||
; tree
|
; tree
|
||||||
; jbuilds
|
; jbuilds
|
||||||
|
|
Loading…
Reference in New Issue