Print package build progress status messages (ocaml#10803)

First pass at printing messages to the console indicating when a
package is being downloaded and built. This is disabled by default and
enabled with a config variable.

Signed-off-by: Stephen Sherratt <[email protected]>

src/dune_rules/pkg_build_progress.ml

@@ -0,0 +1,82 @@
+open! Import
+
+let enabled = Config.make_toggle ~name:"pkg_build_progress" ~default:`Disabled
+
+module Status = struct
+  type t =
+    [ `Downloading
+    | `Building
+    ]
+
+  let to_string = function
+    | `Downloading -> "Downloading"
+    | `Building -> "Building"
+  ;;
+end
+
+module Message = struct
+  type t =
+    { package_name : Package.Name.t
+    ; package_version : Package_version.t
+    ; status : Status.t
+    }
+
+  let user_message { package_name; package_version; status } =
+    let status_tag = User_message.Style.Ok in
+    User_message.make
+      [ Pp.concat
+          [ Pp.tag status_tag (Pp.text (Status.to_string status))
+          ; Pp.textf
+              " %s.%s"
+              (Package.Name.to_string package_name)
+              (Package_version.to_string package_version)
+          ]
+      ]
+  ;;
+
+  let display t =
+    match Config.get enabled with
+    | `Enabled -> Console.print_user_message (user_message t)
+    | `Disabled -> ()
+  ;;
+
+  let encode { package_name; package_version; status } =
+    Sexp.List
+      [ Sexp.Atom (Package.Name.to_string package_name)
+      ; Sexp.Atom (Package_version.to_string package_version)
+      ; Sexp.Atom (Status.to_string status)
+      ]
+  ;;
+end
+
+module Spec = struct
+  type ('path, 'target) t = Message.t
+
+  let name = "progress-action"
+  let version = 1
+  let is_useful_to ~memoize:_ = true
+  let bimap t _f _g = t
+
+  let encode t _ _ =
+    Sexp.List [ Sexp.Atom name; Sexp.Atom (Int.to_string version); Message.encode t ]
+  ;;
+
+  let action t ~ectx:_ ~eenv:_ =
+    let open Fiber.O in
+    let+ () = Fiber.return () in
+    Message.display t
+  ;;
+end
+
+let progress_action package_name package_version status =
+  let module M = struct
+    type path = Path.t
+    type target = Path.Build.t
+
+    module Spec = Spec
+
+    let v = { Message.package_name; package_version; status }
+  end
+  in
+  Action.Extension (module M)
+;;

src/dune_rules/pkg_build_progress.mli

@@ -0,0 +1,14 @@
+open! Import
+
+(** An action which prints a progress message about a package to
+    the console so users can be informed about which of their
+    project's dependencies are currently being installed.
+
+    The message will only print if the
+    DUNE_CONFIG__PKG_BUILD_PROGRESS config variable is "enabled"
+    (it's "disabled" by default). *)
+val progress_action
+  :  Package.Name.t
+  -> Package_version.t
+  -> [ `Downloading | `Building ]
+  -> Action.t

src/dune_rules/pkg_rules.ml

@@ -1675,6 +1675,16 @@ let source_rules (pkg : Pkg.t) =
        | `Local (`File, _) | `Fetch ->
          let fetch =
            Fetch_rules.fetch ~target:pkg.write_paths.source_dir `Directory source
+           |> With_targets.map
+                ~f:
+                  (Action.Full.map ~f:(fun action ->
+                     let progress =
+                       Pkg_build_progress.progress_action
+                         pkg.info.name
+                         pkg.info.version
+                         `Downloading
+                     in
+                     Action.progn [ progress; action ]))
          in
          Memo.return (Dep.Set.of_files [ pkg.paths.source_dir ], [ loc, fetch ])
        | `Local (`Directory, source_root) ->
@@ -1713,7 +1723,7 @@ let source_rules (pkg : Pkg.t) =
 
 let build_rule context_name ~source_deps (pkg : Pkg.t) =
   let+ build_action =
-    let+ build_and_install =
+    let+ copy_action, build_action, install_action =
       let+ copy_action =
         let+ copy_action =
           Fs_memo.dir_exists
@@ -1784,7 +1794,7 @@ let build_rule context_name ~source_deps (pkg : Pkg.t) =
           in
           [ mkdir_install_dirs; install_action ]
       in
-      List.concat [ copy_action; build_action; install_action ]
+      copy_action, build_action, install_action
     in
     let install_file_action =
       let prefix_outside_build_dir = Path.as_outside_build_dir pkg.paths.prefix in
@@ -1798,7 +1808,20 @@ let build_rule context_name ~source_deps (pkg : Pkg.t) =
       |> Action_builder.return
       |> Action_builder.with_no_targets
     in
-    Action_builder.progn (build_and_install @ [ install_file_action ])
+    (* Action to print a "Building" message for the package if its
+       target directory is not yet created. *)
+    let progress_building =
+      Pkg_build_progress.progress_action pkg.info.name pkg.info.version `Building
+      |> Action.Full.make
+      |> Action_builder.return
+      |> Action_builder.with_no_targets
+    in
+    Action_builder.progn
+      (copy_action
+       @ [ progress_building ]
+       @ build_action
+       @ install_action
+       @ [ install_file_action ])
   in
   let deps = Dep.Set.union source_deps (Pkg.package_deps pkg) in
   let open Action_builder.With_targets.O in