From 7a5698c7b1667ac3272afd1d4b8c8900e163edc5 Mon Sep 17 00:00:00 2001 From: Jeremie Dimino Date: Fri, 29 Sep 2017 14:09:41 +0100 Subject: [PATCH] Interpret jbuild-ignore files sooner Interpret then while loading the file tree. --- src/build_system.ml | 16 ++++---- src/file_tree.ml | 79 ++++++++++++++++++++---------------- src/file_tree.mli | 16 +++++--- src/jbuild_load.ml | 98 +++++++++++++++++++++------------------------ 4 files changed, 108 insertions(+), 101 deletions(-) diff --git a/src/build_system.ml b/src/build_system.ml index 5ec9745e..70a0b4f0 100644 --- a/src/build_system.ml +++ b/src/build_system.ml @@ -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) -> diff --git a/src/file_tree.ml b/src/file_tree.ml index 29b2c544..50d9377e 100644 --- a/src/file_tree.ml +++ b/src/file_tree.ml @@ -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)) diff --git a/src/file_tree.mli b/src/file_tree.mli index ad41e6ea..b9a5cd93 100644 --- a/src/file_tree.mli +++ b/src/file_tree.mli @@ -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 diff --git a/src/jbuild_load.ml b/src/jbuild_load.ml index 2d3100a1..5b7d3f4a 100644 --- a/src/jbuild_load.ml +++ b/src/jbuild_load.ml @@ -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