From 63a65111f5597751d199f125358ff7d816c2dfc5 Mon Sep 17 00:00:00 2001 From: Barret Schloerke Date: Thu, 14 Mar 2024 09:32:24 -0400 Subject: [PATCH] Suppress output when installing first time in test_in_local --- R/install.R | 114 ++++++++++++++++------------------------------ R/test-in-local.R | 5 +- 2 files changed, 41 insertions(+), 78 deletions(-) diff --git a/R/install.R b/R/install.R index 996442f4c5..e29d765e8b 100644 --- a/R/install.R +++ b/R/install.R @@ -18,80 +18,32 @@ shinycoreci_is_local <- function() { } -# # Used in GHA workflow -# install_shinyverse_local <- function( -# ..., -# # Install into normal libpath so caching is automatically handled -# libpath = .libPaths()[1], -# install_apps_deps = FALSE) { -# install_shinyverse(..., libpath = libpath, install_apps_deps = install_apps_deps) -# } - -# #' @noRd -# #' @return lib path being used -# install_shinyverse_old <- function( -# install = TRUE, -# validate_loaded = TRUE, -# upgrade = TRUE, # pak::pkg_install(upgrade = FALSE) -# dependencies = NA, # pak::pkg_install(dependencies = NA) -# extra_packages = NULL, -# install_apps_deps = TRUE, -# libpath = resolve_libpath()) { -# if (!isTRUE(install)) { -# return(.libPaths()[1]) -# } - -# # Make sure none of the shinyverse is loaded into namespace -# if (isTRUE(validate_loaded)) { -# shiny_search <- paste0("package:", shinyverse_pkgs) -# if (any(shiny_search %in% search())) { -# bad_namespaces <- shinyverse_pkgs[shiny_search %in% search()] -# stop( -# "The following packages are already loaded:\n", -# paste0("* ", bad_namespaces, "\n", collapse = ""), -# "Please restart and try again" -# ) -# } -# } - -# # Remove shinyverse -# pak_apps_deps <- -# if (isTRUE(install_apps_deps)) { -# apps_deps[!(apps_deps %in% c("shinycoreci"))] -# } else { -# NULL -# } - -# # Load pak into current namespace -# pkgs <- c(pak_apps_deps, extra_packages) -# message("Install libpath: ", libpath) -# message("Installing pkgs:\n", paste0("* ", pkgs, collapse = "\n")) -# # if (!is.null(extra_packages)) { -# # message("Extra packages:\n", paste0("* ", extra_packages, collapse = "\n")) -# # } - -# install_pkgs_with_callr(pkgs, libpath = libpath, upgrade = upgrade, dependencies = dependencies) -# return(libpath) -# } # Attempt to set up all the packages in the shinyverse, even if they are not directly depended upon. attempt_to_install_universe <- function( ..., - libpath = .libPaths()[1] + libpath = .libPaths()[1], + verbose = TRUE ) { stopifnot(length(list(...)) == 0) tryCatch( { - install_missing_pkgs(shinyverse_pkgs, libpath = libpath) + install_missing_pkgs(shinyverse_pkgs, libpath = libpath, prompt = "Installing shinyverse packages: ", verbose = verbose) }, error = function(e) { # Couldn't install all at once, Installing individually - message("Failed to install shinyverse packages in a single attempt. Trying individually.") - lapply(shinyverse_pkgs, function(pkg) { + message("Failed to install shinyverse packages in a single attempt. Error: ", e) + message("Installing shinyverse packages individually!") + Map(seq_along(shinyverse_pkgs), shinyverse_pkgs, f = function(i, pkg) { tryCatch( { - install_missing_pkgs(pkg, libpath = libpath) + install_missing_pkgs( + pkg, + libpath = libpath, + prompt = paste0("[", i, "/", length(shinyverse_pkgs), "] Installing shinyverse package: "), + verbose = verbose + ) }, error = function(e) { message("Failed to install ", pkg, " from universe") @@ -110,16 +62,14 @@ attempt_to_install_universe <- function( # If more than one app name is provided, run through all of them individually install_missing_app_deps <- function( app_name = names(apps_deps_map), + ..., libpath = .libPaths()[1], upgrade = FALSE, - dependencies = NA - # , - # ..., - # recursing = FALSE + dependencies = NA, + verbose = TRUE ) { - # if (!isTRUE(recursing)) { - # install_troublesome_pkgs_old(libpath = libpath) - # } + stopifnot(length(list(...)) == 0) + app_deps <- if (length(app_name) > 1) { unique(unlist( @@ -136,7 +86,8 @@ install_missing_app_deps <- function( app_deps, libpath = libpath, upgrade = upgrade, - dependencies = dependencies + dependencies = dependencies, + verbose = verbose ) invisible() @@ -150,22 +101,30 @@ installed_pkgs <- new.env(parent = emptyenv()) # packages is what is really installed given the value of packages install_missing_pkgs <- function( packages, + ..., libpath = .libPaths()[1], upgrade = FALSE, - dependencies = NA) { + dependencies = NA, + prompt = "Installing missing packages: ", + verbose = TRUE +) { + stopifnot(length(list(...)) == 0) pkgs_to_install <- packages[!(packages %in% names(installed_pkgs))] if (length(pkgs_to_install) > 0) { message( - "Installing missing packages: ", + prompt, paste0(pkgs_to_install, collapse = ", ") ) + message("libpath: ", libpath) + install_pkgs_with_callr( pkgs_to_install, libpath = libpath, upgrade = upgrade, - dependencies = dependencies + dependencies = dependencies, + verbose = verbose ) # Update the installed status as an install error was not thrown for (package in pkgs_to_install) { @@ -179,12 +138,15 @@ install_missing_pkgs <- function( install_pkgs_with_callr <- function( packages, + ..., libpath = .libPaths()[1], upgrade = TRUE, # pak::pkg_install(upgrade = FALSE) - dependencies = NA # pak::pkg_install(dependencies = NA) + dependencies = NA, # pak::pkg_install(dependencies = NA) + verbose = TRUE ) { + stopifnot(length(list(...)) == 0) callr::r( - function(packages, lib, upgrade, dependencies) { + function(packages, upgrade, dependencies) { options(repos = c( # Use the shinycoreci universe to avoid GH rate limits! "AAA" = "https://posit-dev-shinycoreci.r-universe.dev", @@ -197,7 +159,6 @@ install_pkgs_with_callr <- function( pak__pkg_install <- utils::getFromNamespace("pkg_install", "pak") pak__pkg_install( packages, - lib = lib, ask = FALSE, # Not interactive, so don't ask upgrade = upgrade, dependencies = dependencies @@ -205,11 +166,12 @@ install_pkgs_with_callr <- function( }, list( packages = packages, - lib = libpath, upgrade = upgrade, dependencies = dependencies ), - show = TRUE, + show = verbose, + libpath = libpath, + supervise = TRUE, spinner = TRUE # helps with CI from timing out ) } diff --git a/R/test-in-local.R b/R/test-in-local.R index 5af35a14ae..86f33aafb2 100644 --- a/R/test-in-local.R +++ b/R/test-in-local.R @@ -55,7 +55,7 @@ test_in_local <- function( run_test <- function(app_name, show_output = TRUE) { if (should_install) { install_result <- try({ - install_missing_app_deps(app_name, libpath = libpath) + install_missing_app_deps(app_name, libpath = libpath, verbose = show_output) }) # Check for installation results if (inherits(install_result, "try-error")) { @@ -105,7 +105,8 @@ test_in_local <- function( timeout = timeout, stdout = log_file, stderr = "2>&1", - show = show_output + show = show_output, + supervise = TRUE ) result <- test_result$result[[1]] status <-