Report progress only in dune_load or upgraded (#2727)

Report progress only in dune_load or upgraded

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

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

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

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);