From 1af72c4a5da9b33fb4f55400ef18b8f08a15ae99 Mon Sep 17 00:00:00 2001 From: Rudi Grinberg Date: Thu, 10 Oct 2019 12:25:07 +0900 Subject: [PATCH] Add File_tree.fold_with_progress This is the only function that will report progress when scanning the directories. Signed-off-by: Rudi Grinberg --- src/dune/dune_load.ml | 2 +- src/dune/file_tree.ml | 21 ++++++++++++++------- src/dune/file_tree.mli | 4 ++++ src/dune/upgrader.ml | 5 ++--- 4 files changed, 21 insertions(+), 11 deletions(-) diff --git a/src/dune/dune_load.ml b/src/dune/dune_load.ml index 380758427a1..37bdb0cb249 100644 --- a/src/dune/dune_load.ml +++ b/src/dune/dune_load.ml @@ -206,7 +206,7 @@ let load ~ancestor_vcs () = File_tree.init Path.Source.root ~ancestor_vcs ~recognize_jbuilder_projects:false; let projects = - File_tree.Dir.fold (File_tree.root ()) + File_tree.fold_with_progress ~traverse:{ data_only = false; vendored = true; normal = true } ~init:[] ~f:(fun dir acc -> let p = File_tree.Dir.project dir in diff --git a/src/dune/file_tree.ml b/src/dune/file_tree.ml index ed9aaf897f0..4df52b863fb 100644 --- a/src/dune/file_tree.ml +++ b/src/dune/file_tree.ml @@ -252,14 +252,8 @@ let init root ~ancestor_vcs ~recognize_jbuilder_projects = let make_root { Settings.root = path; ancestor_vcs; recognize_jbuilder_projects } = let open Result.O in - let nb_path_visited = ref 0 in - Console.Status_line.set (fun () -> - Some - (Pp.verbatim (Printf.sprintf "Scanned %i directories" !nb_path_visited))); let rec walk path ~dirs_visited ~project:parent_project ~vcs ~(dir_status : Sub_dirs.Status.t) { Readdir.dirs; files } = - incr nb_path_visited; - if !nb_path_visited mod 100 = 0 then Console.Status_line.refresh (); let project = if dir_status = Data_only then parent_project @@ -364,7 +358,6 @@ let make_root ~dirs_visited:(File.Map.singleton (File.of_source_path path) path) ~dir_status:Normal ~project ~vcs:ancestor_vcs x in - Console.Status_line.set (Fn.const None); match walk with | Ok dir -> dir | Error m -> @@ -432,3 +425,17 @@ let dir_exists path = Option.is_some (find_dir path) let dir_is_vendored path = Option.map ~f:(fun dir -> Dir.vendored dir) (find_dir path) + +let fold_with_progress ~traverse ~init ~f = + let root = root () in + let nb_path_visited = ref 0 in + Console.Status_line.set (fun () -> + Some (Pp.textf "Scanned %i directories" !nb_path_visited)); + let res = + Dir.fold root ~traverse ~init ~f:(fun dir acc -> + incr nb_path_visited; + if !nb_path_visited mod 100 = 0 then Console.Status_line.refresh (); + f dir acc) + in + Console.Status_line.set (Fn.const None); + res diff --git a/src/dune/file_tree.mli b/src/dune/file_tree.mli index 00307705f01..faffca3df30 100644 --- a/src/dune/file_tree.mli +++ b/src/dune/file_tree.mli @@ -71,6 +71,10 @@ val init : val root : unit -> Dir.t +(** Traverse starting from the root and report progress in the status line *) +val fold_with_progress : + traverse:Sub_dirs.Status.Set.t -> init:'a -> f:(Dir.t -> 'a -> 'a) -> 'a + val find_dir : Path.Source.t -> Dir.t option (** [nearest_dir t fn] returns the directory with the longest path that is an diff --git a/src/dune/upgrader.ml b/src/dune/upgrader.ml index 66c1a3d6977..50163bdb1fd 100644 --- a/src/dune/upgrader.ml +++ b/src/dune/upgrader.ml @@ -382,9 +382,8 @@ let upgrade_dir todo dir = let upgrade () = Dune_project.default_dune_language_version := (1, 0); let todo = { to_rename_and_edit = []; to_add = []; to_edit = [] } in - let root = File_tree.root () in - File_tree.Dir.fold root ~traverse:Sub_dirs.Status.Set.normal_only ~init:() - ~f:(fun dir () -> upgrade_dir todo dir); + File_tree.fold_with_progress ~traverse:Sub_dirs.Status.Set.normal_only + ~init:() ~f:(fun dir () -> upgrade_dir todo dir); let log fmt = Printf.ksprintf Console.print fmt in List.iter todo.to_edit ~f:(fun (fn, s) -> log "Upgrading %s...\n" (Path.Source.to_string_maybe_quoted fn);