diff --git a/DESCRIPTION b/DESCRIPTION index 787cb2d..975f34b 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,6 +1,6 @@ Package: condathis Title: Run Any CLI Tool on a 'Conda' Environment -Version: 0.0.7.9010 +Version: 0.0.7.9011 Authors@R: c( person("Lucio", "Queiroz", , "luciorqueiroz@gmail.com", role = c("aut", "cre", "cph"), comment = c(ORCID = "0000-0002-6090-1834")), diff --git a/R/create_env.R b/R/create_env.R index c73a835..91d0032 100644 --- a/R/create_env.R +++ b/R/create_env.R @@ -156,22 +156,26 @@ create_env <- function( quiet_flag <- parse_quiet_flag(verbose = verbose) - px_res <- native_cmd( - conda_cmd = "create", - conda_args = c( - "-n", - env_name, - "--yes", - quiet_flag, - "--no-channel-priority", - "--override-channels", - "--channel-priority=0", - channels_arg, - platform_args - ), - packages_arg, - verbose = verbose, - error = "cancel" + px_res <- rethrow_error_cmd( + expr = { + native_cmd( + conda_cmd = "create", + conda_args = c( + "-n", + env_name, + "--yes", + quiet_flag, + "--no-channel-priority", + "--override-channels", + "--channel-priority=0", + channels_arg, + platform_args + ), + packages_arg, + verbose = verbose, + error = "cancel" + ) + } ) } if (isTRUE(verbose %in% c("full", "output"))) { diff --git a/R/install_packages.R b/R/install_packages.R index b415cd0..f4237eb 100644 --- a/R/install_packages.R +++ b/R/install_packages.R @@ -45,20 +45,24 @@ install_packages <- function(packages, additional_channels, channels ) - px_res <- native_cmd( - conda_cmd = "install", - conda_args = c( - "-n", - env_name, - "--yes", - quiet_flag, - "--no-channel-priority", - "--override-channels", - "--channel-priority=0", - channels_arg - ), - packages, - verbose = verbose + px_res <- rethrow_error_cmd( + expr = { + native_cmd( + conda_cmd = "install", + conda_args = c( + "-n", + env_name, + "--yes", + quiet_flag, + "--no-channel-priority", + "--override-channels", + "--channel-priority=0", + channels_arg + ), + packages, + verbose = verbose + ) + } ) if (isTRUE(verbose %in% c("full", "output") && length(packages) > 0L)) { diff --git a/R/list_envs.R b/R/list_envs.R index 236f27b..31eb8d6 100644 --- a/R/list_envs.R +++ b/R/list_envs.R @@ -33,14 +33,18 @@ #' @export list_envs <- function(verbose = "silent") { env_root_dir <- get_install_dir() - px_res <- native_cmd( - conda_cmd = "env", - conda_args = c( - "list", - "-q", - "--json" - ), - verbose = verbose + px_res <- rethrow_error_cmd( + expr = { + native_cmd( + conda_cmd = "env", + conda_args = c( + "list", + "-q", + "--json" + ), + verbose = verbose + ) + } ) if (isTRUE(px_res$status == 0)) { envs_list <- jsonlite::fromJSON(px_res$stdout) diff --git a/R/list_packages.R b/R/list_packages.R index 0a045b9..1f2b5bd 100644 --- a/R/list_packages.R +++ b/R/list_packages.R @@ -44,15 +44,19 @@ list_packages <- function(env_name = "condathis-env", verbose = "silent") { ) } quiet_flag <- parse_quiet_flag(verbose = verbose) - px_res <- native_cmd( - conda_cmd = "list", - conda_args = c( - "-n", - env_name, - quiet_flag, - "--json" - ), - verbose = verbose + px_res <- rethrow_error_cmd( + expr = { + native_cmd( + conda_cmd = "list", + conda_args = c( + "-n", + env_name, + quiet_flag, + "--json" + ), + verbose = verbose + ) + } ) if (isTRUE(px_res$status == 0)) { pkgs_df <- jsonlite::fromJSON(px_res$stdout) diff --git a/R/remove_env.R b/R/remove_env.R index 4b0de40..7a67413 100644 --- a/R/remove_env.R +++ b/R/remove_env.R @@ -32,16 +32,20 @@ remove_env <- function(env_name = "condathis-env", ) } quiet_flag <- parse_quiet_flag(verbose = verbose) - px_res <- native_cmd( - conda_cmd = "env", - conda_args = c( - "remove", - "-n", - env_name, - "--yes", - quiet_flag - ), - verbose = verbose + px_res <- rethrow_error_cmd( + expr = { + native_cmd( + conda_cmd = "env", + conda_args = c( + "remove", + "-n", + env_name, + "--yes", + quiet_flag + ), + verbose = verbose + ) + } ) if (isTRUE(verbose %in% c("full", "output"))) { cli::cli_inform( diff --git a/R/rethrow_error_cmd.R b/R/rethrow_error_cmd.R new file mode 100644 index 0000000..a1c0dfe --- /dev/null +++ b/R/rethrow_error_cmd.R @@ -0,0 +1,41 @@ +#' @keywords internal +#' @noRd +rethrow_error_cmd <- function(expr, env = parent.frame()) { + code <- base::substitute(expr = expr) + err_cnd <- rlang::catch_cnd( + expr = { + px_res <- rlang::eval_bare(expr = code, env = env) + }, + classes = c("system_command_status_error", "rlib_error_3_0", "c_error") + ) + + if (isFALSE(is.null(err_cnd))) { + additional_lines <- NULL + if (isTRUE("stderr" %in% names(err_cnd))) { + additional_lines <- stringr::str_split( + string = stringr::str_trim(err_cnd[["stderr"]]), + pattern = stringr::regex("\\R"), + simplify = FALSE + )[[1]] + } + + status_code <- NULL + if (isFALSE("status" %in% names(err_cnd))) { + status_code <- "127" + additional_lines <- c("micromamba: command not found", additional_lines) + } else { + status_code <- err_cnd[["status"]] + } + + env[["status_code"]] <- status_code + cli::cli_abort( + message = c( + additional_lines + ), + class = "condathis_cmd_status_error", + .envir = env + ) + } + + return(px_res) +} diff --git a/R/rethrow_error_run.R b/R/rethrow_error_run.R new file mode 100644 index 0000000..476c8d8 --- /dev/null +++ b/R/rethrow_error_run.R @@ -0,0 +1,43 @@ +#' @keywords internal +#' @noRd +rethrow_error_run <- function(expr, env = parent.frame()) { + code <- base::substitute(expr = expr) + err_cnd <- rlang::catch_cnd( + expr = { + px_res <- rlang::eval_bare(expr = code, env = env) + }, + classes = c("system_command_status_error", "rlib_error_3_0", "c_error") + ) + + if (isFALSE(is.null(err_cnd))) { + additional_lines <- NULL + if (isTRUE("stderr" %in% names(err_cnd))) { + additional_lines <- stringr::str_split( + string = stringr::str_trim(err_cnd[["stderr"]]), + pattern = stringr::regex("\\R"), + simplify = FALSE + )[[1]] + } + + status_code <- NULL + if (isFALSE("status" %in% names(err_cnd))) { + status_code <- "127" + additional_lines <- c("{cmd}: command not found", additional_lines) + } else { + status_code <- err_cnd[["status"]] + } + + env[["status_code"]] <- status_code + cli::cli_abort( + message = c( + `x` = "System command {.field {cmd}} failed", + `!` = "Status code: {status_code}", + additional_lines + ), + class = "condathis_run_status_error", + .envir = env + ) + } + + return(px_res) +} diff --git a/R/run.R b/R/run.R index 195cb67..ab66160 100644 --- a/R/run.R +++ b/R/run.R @@ -90,14 +90,18 @@ run <- function(cmd, method_to_use <- method[1] if (isTRUE(method_to_use %in% c("native", "auto"))) { - px_res <- run_internal_native( - cmd = cmd, - ..., - env_name = env_name, - verbose = verbose, - error = error, - stdout = stdout, - stderr = stderr + px_res <- rethrow_error_run( + expr = { + run_internal_native( + cmd = cmd, + ..., + env_name = env_name, + verbose = verbose, + error = error, + stdout = stdout, + stderr = stderr + ) + } ) } return(invisible(px_res)) diff --git a/R/run_bin.R b/R/run_bin.R index 2cce8c7..4581fe8 100644 --- a/R/run_bin.R +++ b/R/run_bin.R @@ -88,15 +88,20 @@ run_bin <- function( args_vector <- character(length = 0L) } - px_res <- processx::run( - command = cmd_path, - args = args_vector, - spinner = spinner_flag, - echo_cmd = verbose_cmd, - echo = verbose_output, - stdout = stdout, - stderr = stderr, - error_on_status = error_var + px_res <- rethrow_error_run( + expr = { + processx::run( + command = cmd_path, + args = args_vector, + spinner = spinner_flag, + echo_cmd = verbose_cmd, + echo = verbose_output, + stdout = stdout, + stderr = stderr, + error_on_status = error_var + ) + } ) + return(invisible(px_res)) } diff --git a/tests/testthat/test-create_env.R b/tests/testthat/test-create_env.R index 77a25cd..39b56a9 100644 --- a/tests/testthat/test-create_env.R +++ b/tests/testthat/test-create_env.R @@ -62,7 +62,7 @@ testthat::test_that("conda env is created", { error = "cancel" ) }, - class = "rlib_error" + class = "condathis_run_status_error" ) run_res <- run(