Basic tty improvements

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: checked
 Title: Systematically Run R CMD Checks
-Version: 0.5.3
+Version: 0.5.4
 Authors@R:
     c(
       person(

NEWS.md

@@ -1,3 +1,9 @@
+# checked 0.5.4
+
+* Improve error messaging when using basic_tty
+
+* Various improvements to reporters and minor display tweaks
+
 # checked 0.5.3
 
 * Make is possible to construct reporter environments with additional values

R/checker.R

@@ -228,6 +228,14 @@ checker <- R6::R6Class(
         all(V(self$graph)$status == STATUS$done)
       }
 
+    },
+    #' @description
+    #' Tasks
+    #'
+    #' Returns what type of tasks the checker consists of and returns a unique
+    #' vector of primary classes
+    tasks = function() {
+      unique(vcapply(V(self$graph)$task, function(x) class(x)[[1]]))
     }
   ),
   private = list(

R/install.R

@@ -19,36 +19,30 @@ install_process <- R6::R6Class(
       private$package <- pkgs
       self$log <- log
       private$callr_r_bg(
-        function(..., escalate_warning, available_packages_filters) {
+        function(..., available_packages_filters) {
           options(
             timeout = 600,
             available_packages_filters = available_packages_filters
           )
-          withCallingHandlers(
+          invisible(capture.output(withCallingHandlers(
             utils::install.packages(..., quiet = FALSE, verbose = TRUE),
             warning = function(w) {
-              if (escalate_warning(w)) {
-                print(w$message)
-                stop(w$message)
-              } else {
-                print(w$message)
-                warning(w)
-              }
+              print(w$message)
             }
-          )
+          ), split = TRUE))
         },
         args = list(
           private$package,
           ...,
           lib = lib,
-          escalate_warning = is_install_failure_warning,
           available_packages_filters = available_packages_filters
         ),
         libpath = libpaths,
         stdout = self$log,
         stderr = "2>&1",
         system_profile = options::opt("install_system_profile"),
         user_profile = options::opt("install_user_profile"),
+        cmdargs = c("--slave", "--no-save", "--no-restore", "--vanilla"),
         env = env
       )
     },
@@ -68,7 +62,26 @@ install_process <- R6::R6Class(
       if (is.function(f <- private$finish_callback)) f(self)
     },
     get_r_exit_status = function() {
-      as.integer(inherits(try(self$get_result(), silent = TRUE), "try-error"))
+      res <- self$get_results_safe()
+      if (inherits(self$get_results_safe(), "callr_error")) {
+        1L
+      } else if (any(is_install_failure_warning(res))) {
+        1L
+      } else {
+        0L
+      }
+
+    },
+    get_results_safe = function() {
+      tryCatch(
+        gsub("\\n", "\n", self$get_result(), fixed = TRUE),
+        error = function(e) {
+          e
+        },
+        warning = function(w) {
+          w
+        }
+      )
     }
   ),
   private = list(
@@ -115,5 +128,5 @@ is_install_failure_warning <- function(w) {
   )
 
   re <- paste0("(", paste0(patterns, collapse = "|"), ")")
-  grepl(re, w$message)
+  grepl(re, w)
 }

R/next_task.R

@@ -87,9 +87,7 @@ start_task.install_task <- function(
     upgrade %nif% task$origin$version
   )
 
-  if (is_installed &&
-      is_lib_path_default(task) &&
-      inherits(task$origin, "pkg_origin_repo"))
+  if (is_installed && is_lib_path_default(task) && inherits(task$origin, "pkg_origin_repo")) # nolint
     return(NULL)
 
   install_process$new(

R/reporter.R

@@ -22,6 +22,7 @@
 #' a reporter with minimal assumptions about terminal capabilities.
 #'
 #' @param checks_only whether basic tty reporter should report only check tasks.
+#' @param checker checker object required to properly derive default reporter.
 #' @param ... additional values which should be assigned to the reported
 #'  environment.
 #'
@@ -58,8 +59,11 @@ reporter_basic_tty <- function(checks_only = FALSE, ...) {
 
 #' @rdname reporters
 #' @export
-reporter_default <- function() {
-  if (cli::is_ansi_tty()) {
+reporter_default <- function(checker = NULL) {
+  is_revdep <-
+    !is.null(checker) && "rev_dep_check_meta_task" %in% checker$tasks()
+
+  if (cli::is_ansi_tty() && is_revdep) {
     reporter_ansi_tty()
   } else if (cli::is_dynamic_tty()) {
     reporter_basic_tty()

R/reporter_basic_tty.R

@@ -19,7 +19,13 @@ report_start_setup.reporter_basic_tty <- function(
 
   reporter$time_start <- Sys.time()
 
-  cli::cli_text("<", utils::packageName(), "> Checks")
+  type <- if (all(vlapply(v_reportable$task, inherits, "install_task"))) {
+    "> Installs"
+  } else {
+    "> Checks"
+  }
+
+  cli::cli_text("<", utils::packageName(), type)
 }
 
 #' @export
@@ -41,6 +47,7 @@ report_status.reporter_basic_tty <- function(reporter, checker, envir) {
 
     p <- node$process
 
+    failure_message <- NULL
     # report stating of new checks
     if (!identical(node$status, reporter$status[[node$name]])) {
       status <- switch( # nolint
@@ -61,12 +68,19 @@ report_status.reporter_basic_tty <- function(reporter, checker, envir) {
             )
           } else if (p$get_r_exit_status() != 0) {
             # checks processes don't have logs associated with it
-            message <- if (!is.null(p$log)) {
-              sprintf("failed (log: '%s')", p$log)
-            } else {
-              "failed"
+            failure_message <- if (inherits(p, "install_process")) {
+              paste(
+                p$get_results_safe(),
+                if (file.exists(p$log)) sprintf("\nfull log: '%s'", p$log),
+                sep = "\n",
+                collapse = "\n"
+              )
             }
-            cli::cli_fmt(cli::cli_text(message))
+            cli::cli_fmt(
+              cli::cli_text(
+                "failed", cli::format_inline(fmt_count)
+              )
+            )
           } else {
             dur <- if (!is.null(p$get_duration)) {
               p$get_duration()
@@ -103,6 +117,7 @@ report_status.reporter_basic_tty <- function(reporter, checker, envir) {
       type <- format_task_type(node$task) # nolint (used via glue)
       prefix <- cli::col_cyan("[{format_time(time)}][{type}] ")
       cli::cli_text(prefix, "{.pkg {package(node$task)}} {status}")
+      if (!is.null(failure_message)) cli::cli_text(failure_message)
       reporter$status[[node$name]] <- node$status
     }
   }

R/run.R

@@ -13,12 +13,12 @@
 #'   most expressive command-line reporter given your terminal capabilities.
 #'
 #' @export
-run <- function(checker, ..., reporter = reporter_default()) {
+run <- function(checker, ..., reporter = reporter_default(checker)) {
   UseMethod("run")
 }
 
 #' @export
-run.character <- function(checker, ..., reporter = reporter_default()) {
+run.character <- function(checker, ..., reporter = reporter_default(checker)) {
   checker <- new_rev_dep_checker(checker, ...)
   report_start_setup(
     reporter,
@@ -30,7 +30,7 @@ run.character <- function(checker, ..., reporter = reporter_default()) {
 }
 
 #' @export
-run.checker <- function(checker, ..., reporter = reporter_default()) {
+run.checker <- function(checker, ..., reporter = reporter_default(checker)) {
   on.exit(add = TRUE, {
     checker$terminate()
     report_finalize(reporter, checker)