From a3ca51c231ba8a8161b1d883f8fca001dadfa6fa Mon Sep 17 00:00:00 2001
From: pat-s <patrick.schratz@gmail.com>
Date: Mon, 30 Sep 2024 11:32:45 +0200
Subject: [PATCH] improve debug mode, use progress instead of cli progress
 report mode

---
 DESCRIPTION        |  1 +
 R/build_binaries.R | 25 +++++++++++++++++++------
 2 files changed, 20 insertions(+), 6 deletions(-)

diff --git a/DESCRIPTION b/DESCRIPTION
index c2be87e..53f527a 100644
--- a/DESCRIPTION
+++ b/DESCRIPTION
@@ -12,6 +12,7 @@ Imports:
     dplyr,
     future,
     future.apply,
+    future.callr,
     gert,
     lubridate,
     magrittr,
diff --git a/R/build_binaries.R b/R/build_binaries.R
index 2e1c381..07ad149 100644
--- a/R/build_binaries.R
+++ b/R/build_binaries.R
@@ -97,11 +97,16 @@ build_binary_package <- function(package_name, tag = NULL, codename = NULL,
     rscript_startup = quote(options(crayon.enabled = TRUE))
   )
 
-  progressr::handlers("cli")
+  # 'cli' is slow -> https://github.com/HenrikBengtsson/progressr/issues/167
+  if (debug) {
+    progressr::handlers("debug")
+  } else {
+    progressr::handlers("progress")
+  }
   p <- progressr::progressor(along = tag)
 
-  worker_fun <- function(x, y, p) {
-    p()
+  worker_fun <- function(x, y, p, debug) {
+    p(message = sprintf("Building '%s'", y))
     tryCatch(
       {
         dump <- build_single_tag(x, y, dir_out_bin, local_clone_dir,
@@ -110,6 +115,8 @@ build_binary_package <- function(package_name, tag = NULL, codename = NULL,
           deps_verbose = deps_verbose
         )
 
+        p(message = sprintf("Done building '%s'", y))
+
         # if for some reason an underlying error didnt' get caught in the tryCatch calls, we check again here for the existence of the binary file on disk and mark the build as failed if it is not found
         tarball_name <- sprintf("%s_%s.tar.gz", x, y)
         if (fs::file_exists(sprintf("%s/%s", local_bin_path, tarball_name))) {
@@ -127,11 +134,17 @@ build_binary_package <- function(package_name, tag = NULL, codename = NULL,
         store_build_metadata(x, y, platform, error_occurred = TRUE, arch = arch, force = TRUE, error = e$stderr)
       }
     )
+    p(message = sprintf("Finished building %s %s", x, y))
   }
 
-  future.apply::future_mapply(worker_fun, package_name, tag,
-    future.seed = TRUE, MoreArgs = list(p)
-  )
+
+  if (debug) {
+    mapply(worker_fun, package_name, tag, MoreArgs = list(p, debug))
+  } else {
+    future.apply::future_mapply(worker_fun, package_name, tag,
+      future.seed = TRUE, MoreArgs = list(p, debug)
+    )
+  }
 
   total_build_time <- round(Sys.time() - t1, 2)
   cli::cli_alert("Execution time ({.pkg {package_name[1]}}) ({length(tag)} tags): {.strong {total_build_time} {units(difftime(Sys.time(), t1))}}.")