From adb5f22b0727fc4cc562df5c87d483ac62ab2935 Mon Sep 17 00:00:00 2001 From: Scott Chamberlain Date: Tue, 15 Oct 2024 11:07:10 -0700 Subject: [PATCH] use rlang::abort throughout instead of stop; use check_installed instead of custom fxn #129 --- NAMESPACE | 2 ++ R/HttpLibAdapterRegistry.R | 2 +- R/RequestPattern.R | 12 ++++++------ R/StubRegistry.R | 10 ++++------ R/StubbedRequest.R | 28 +++++++++++----------------- R/adapter-crul.R | 4 ++-- R/adapter-httr.R | 4 ++-- R/adapter-httr2.R | 2 +- R/adapter.R | 17 ++++++++--------- R/flipswitch.R | 8 ++++---- R/pluck_body.R | 5 ++--- R/stub_request.R | 2 +- R/to_raise.R | 12 +++++++----- R/to_return.R | 4 ++-- R/webmockr-package.R | 1 + R/wi_th.R | 8 ++++---- R/zzz.R | 9 --------- tests/testthat/test-Adapter.R | 12 +++++++++++- tests/testthat/test-to_return_body.R | 2 +- 19 files changed, 70 insertions(+), 74 deletions(-) diff --git a/NAMESPACE b/NAMESPACE index a004cf7..1e93f9b 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -63,6 +63,8 @@ importFrom(base64enc,base64encode) importFrom(crul,mock) importFrom(fauxpas,HTTPRequestTimeout) importFrom(magrittr,"%>%") +importFrom(rlang,abort) +importFrom(rlang,check_installed) importFrom(rlang,is_empty) importFrom(rlang,is_na) importFrom(rlang,is_null) diff --git a/R/HttpLibAdapterRegistry.R b/R/HttpLibAdapterRegistry.R index 7d4c13a..bfd06bf 100644 --- a/R/HttpLibAdapterRegistry.R +++ b/R/HttpLibAdapterRegistry.R @@ -30,7 +30,7 @@ HttpLibAdapaterRegistry <- R6::R6Class( register = function(x) { # FIXME: when other adapters supported, change this inherits test if (!inherits(x, c("CrulAdapter", "HttrAdapter", "Httr2Adapter"))) { - stop("'x' must be an adapter, such as CrulAdapter", call. = FALSE) + abort("'x' must be an adapter, such as CrulAdapter") } self$adapters <- c(self$adapters, x) } diff --git a/R/RequestPattern.R b/R/RequestPattern.R index 47b9bf2..51818ed 100644 --- a/R/RequestPattern.R +++ b/R/RequestPattern.R @@ -94,7 +94,7 @@ RequestPattern <- R6::R6Class( initialize = function(method, uri = NULL, uri_regex = NULL, query = NULL, body = NULL, headers = NULL) { if (is.null(uri) && is.null(uri_regex)) { - stop("one of uri or uri_regex is required", call. = FALSE) + abort("one of uri or uri_regex is required") } self$method_pattern <- MethodPattern$new(pattern = method) @@ -173,10 +173,10 @@ RequestPattern <- R6::R6Class( }, validate_basic_auth = function(x) { if (!inherits(x, "list") || length(unique(unname(unlist(x)))) == 1) { - stop( - "'basic_auth' option should be a list of length 2: username and password", - call. = FALSE - ) + abort(c( + "error in basic auth", + "'basic_auth' option should be list of length 2: username, password" + )) } }, make_basic_auth = function(x, y) { @@ -500,7 +500,7 @@ BodyPattern <- R6::R6Class( if (bctype == "json") { jsonlite::fromJSON(body) } else if (bctype == "xml") { - check_for_pkg("xml2") + check_installed("xml2") try_xml2list <- rlang::try_fetch({ body_xml <- xml2::read_xml(body) xml_as_list <- xml2::as_list(body_xml) diff --git a/R/StubRegistry.R b/R/StubRegistry.R index d09b639..312402a 100644 --- a/R/StubRegistry.R +++ b/R/StubRegistry.R @@ -88,12 +88,10 @@ StubRegistry <- R6::R6Class( if (stub$to_s() %in% xx) { self$request_stubs <- self$request_stubs[-which(stub$to_s() %in% xx)] } else { - stop( - "Request stub \n\n ", - stub$to_s(), - "\n\n is not registered.", - call. = FALSE - ) + abort(c( + "This request stub is not registered:", + stub$to_s() + )) } }, diff --git a/R/StubbedRequest.R b/R/StubbedRequest.R index 458edb5..fbbd921 100644 --- a/R/StubbedRequest.R +++ b/R/StubbedRequest.R @@ -187,7 +187,7 @@ StubbedRequest <- R6::R6Class( self$method <- verb } if (is.null(uri) && is.null(uri_regex)) { - stop("one of uri or uri_regex is required", call. = FALSE) + abort("one of uri or uri_regex is required") } self$uri <- uri self$uri_regex <- uri_regex @@ -281,7 +281,7 @@ StubbedRequest <- R6::R6Class( bod_sum <- summary(body) close.connection(body) if (bod_sum$class != "file") { - stop("'to_return' only supports connections of type 'file'") + abort("'to_return' only supports connections of type 'file'") } structure(bod_sum$description, type = "file") } else { @@ -296,13 +296,10 @@ StubbedRequest <- R6::R6Class( raw() } else { webmockr_stub_registry$remove_request_stub(self) - stop( - paste0( - "Unknown type of `body`: ", - "must be NULL, FALSE, character, raw or list; stub removed" - ), - call. = FALSE - ) + abort(c( + "Unknown `body` type", + "*" = "must be NULL, FALSE, character, raw or list; stub removed" + )) } } else if (inherits(body, "raw")) { body @@ -317,14 +314,11 @@ StubbedRequest <- R6::R6Class( } } else if (!is.list(body)) { webmockr_stub_registry$remove_request_stub(self) - stop( - paste0( - "Unknown type of `body`: ", - "must be numeric, NULL, FALSE, character, json, ", - "raw, list, or file connection; stub removed" - ), - call. = FALSE - ) + abort(c( + "Unknown `body` type", + "*" = "must be: numeric, NULL, FALSE, character, json, raw, list, or file connection", + "*" = "stub removed" + )) } else { charToRaw(jsonlite::toJSON(body, auto_unbox = TRUE)) } diff --git a/R/adapter-crul.R b/R/adapter-crul.R index c4a2593..7ce334e 100644 --- a/R/adapter-crul.R +++ b/R/adapter-crul.R @@ -99,8 +99,8 @@ CrulAdapter <- R6::R6Class("CrulAdapter", # if crul_resp$content is character, it must be a file path (I THINK?) if (is.null(write_disk_path)) { - stop("if writing to disk, write_disk_path must be given; ", - "see ?vcr::vcr_configure") + abort(c("if writing to disk, write_disk_path must be given", + "see ?vcr::vcr_configure")) } response$content <- file.path( diff --git a/R/adapter-httr.R b/R/adapter-httr.R index 64b2d50..93bca9c 100644 --- a/R/adapter-httr.R +++ b/R/adapter-httr.R @@ -65,7 +65,7 @@ httr_cookies_df <- function() { check_user_pwd <- function(x) { if (is.null(x)) return(x) if (grepl("^https?://", x)) { - stop(sprintf("expecting string of pattern 'user:pwd', got '%s'", x)) + abort(c("expecting string of pattern 'user:pwd'", sprintf("got '%s'", x))) } return(x) } @@ -105,7 +105,7 @@ build_httr_request = function(x) { #' to turn off. default: `TRUE` #' @return Silently returns `TRUE` when enabled and `FALSE` when disabled. httr_mock <- function(on = TRUE) { - check_for_pkg("httr") + check_installed("httr") webmockr_handle <- function(req) { webmockr::HttrAdapter$new()$handle_request(req) } diff --git a/R/adapter-httr2.R b/R/adapter-httr2.R index f431bb5..b4c72f1 100644 --- a/R/adapter-httr2.R +++ b/R/adapter-httr2.R @@ -99,7 +99,7 @@ build_httr2_request = function(x) { #' @param on (logical) `TRUE` to turn on, `FALSE` to turn off. default: `TRUE` #' @return Silently returns `TRUE` when enabled and `FALSE` when disabled. httr2_mock <- function(on = TRUE) { - check_for_pkg("httr2") + check_installed("httr2") if (on) { httr2::local_mocked_responses(~ Httr2Adapter$new()$handle_request(.x), env = .GlobalEnv) } else { diff --git a/R/adapter.R b/R/adapter.R index 6c28cf8..584c8f2 100644 --- a/R/adapter.R +++ b/R/adapter.R @@ -55,14 +55,13 @@ Adapter <- R6::R6Class("Adapter", #' @description Create a new Adapter object initialize = function() { if (is.null(self$client)) { - stop( - "Adapter parent class should not be called directly.\n", - "Use one of the following package-specific adapters instead:\n", - " - CrulAdapter$new()\n", - " - HttrAdapter$new()\n", - " - Httr2Adapter$new()\n", - call. = FALSE - ) + abort(c( + "Adapter parent class should not be called directly", + "*" = "Use one of the following package-specific adapters instead:", + "*" = " CrulAdapter$new()", + "*" = " HttrAdapter$new()", + "*" = " Httr2Adapter$new()" + )) } }, @@ -216,7 +215,7 @@ Adapter <- R6::R6Class("Adapter", msgz <- "" } ending <- "\n============================================================" - stop(paste0(msgx, msgy, msgz, ending), call. = FALSE) + abort(paste0(msgx, msgy, msgz, ending)) } return(resp) diff --git a/R/flipswitch.R b/R/flipswitch.R index 3b2a913..9a50831 100644 --- a/R/flipswitch.R +++ b/R/flipswitch.R @@ -24,7 +24,7 @@ enable <- function(adapter = NULL, options = list(), quiet = FALSE) { adnms <- vapply(http_lib_adapter_registry$adapters, function(w) w$client, "") if (!is.null(adapter)) { if (!adapter %in% webmockr_adapters) { - stop("adapter must be one of 'crul', 'httr', or 'httr2'") + abort("adapter must be one of 'crul', 'httr', or 'httr2'") } if (!requireNamespace(adapter, quietly = TRUE)) { message(adapter, " not installed, skipping enable") @@ -50,8 +50,8 @@ enable <- function(adapter = NULL, options = list(), quiet = FALSE) { #' @rdname enable enabled <- function(adapter = "crul") { if (!adapter %in% webmockr_adapters) { - stop("'adapter' must be in the set ", - paste0(webmockr_adapters, collapse = ", ")) + abort(c("'adapter' must be in the set ", + paste0(webmockr_adapters, collapse = ", "))) } webmockr_lightswitch[[adapter]] } @@ -62,7 +62,7 @@ disable <- function(adapter = NULL, options = list(), quiet = FALSE) { adnms <- vapply(http_lib_adapter_registry$adapters, function(w) w$client, "") if (!is.null(adapter)) { if (!adapter %in% webmockr_adapters) { - stop("adapter must be one of 'crul', 'httr', or 'httr2'") + abort("adapter must be one of 'crul', 'httr', or 'httr2'") } if (!requireNamespace(adapter, quietly = TRUE)) { message(adapter, " not installed, skipping disable") diff --git a/R/pluck_body.R b/R/pluck_body.R index e6a5ae9..cfe9220 100644 --- a/R/pluck_body.R +++ b/R/pluck_body.R @@ -34,9 +34,8 @@ pluck_body <- function(x) { # unknown, fail out } else { - stop("couldn't fetch request body; file an issue at \n", - " https://github.com/ropensci/webmockr/issues/", - call. = FALSE) + abort("couldn't fetch request body; file an issue at \n", + " https://github.com/ropensci/webmockr/issues/") } } diff --git a/R/stub_request.R b/R/stub_request.R index 0479edb..a0c77b0 100644 --- a/R/stub_request.R +++ b/R/stub_request.R @@ -191,7 +191,7 @@ #' } stub_request <- function(method = "get", uri = NULL, uri_regex = NULL) { if (is.null(uri) && is.null(uri_regex)) { - stop("one of uri or uri_regex is required", call. = FALSE) + abort("one of uri or uri_regex is required") } tmp <- StubbedRequest$new(method = method, uri = uri, uri_regex = uri_regex) webmockr_stub_registry$register_stub(tmp) diff --git a/R/to_raise.R b/R/to_raise.R index 7ceb97d..1d9e119 100644 --- a/R/to_raise.R +++ b/R/to_raise.R @@ -17,7 +17,7 @@ #' in this case `to_raise()` makes sense. In another case, if a unit test #' expects to test some aspect of an HTTP response object that httr, httr2, #' or crul typically returns, then you'll want `to_return()`. -#' +#' #' @details The behavior in the future will be: #' #' When multiple exceptions are passed, the first is used on the first @@ -29,12 +29,14 @@ to_raise <- function(.data, ...) { assert(.data, "StubbedRequest") tmp <- list(...) - if (!all(vapply(tmp, function(x) inherits(x, "R6ClassGenerator"), - logical(1)))) { - stop("all objects must be error classes from fauxpas") + if (!all(vapply( + tmp, function(x) inherits(x, "R6ClassGenerator"), + logical(1) + ))) { + abort("all objects must be error classes from fauxpas") } if (!all(vapply(tmp, function(x) grepl("HTTP", x$classname), logical(1)))) { - stop("all objects must be error classes from fauxpas") + abort("all objects must be error classes from fauxpas") } .data$to_raise(tmp) return(.data) diff --git a/R/to_return.R b/R/to_return.R index 637a64e..e6d68d5 100644 --- a/R/to_return.R +++ b/R/to_return.R @@ -83,11 +83,11 @@ to_return <- function(.data, ..., .list = list(), times = 1) { !any(c("status", "body", "headers") %in% names(z)) && length(z) != 0 ) { - stop("'to_return' only accepts status, body, headers") + abort("'to_return' only accepts status, body, headers") } assert(z$status, c("numeric", "integer")) assert(z$headers, "list") - if (!all(hz_namez(z$headers))) stop("'headers' must be a named list") + if (!all(hz_namez(z$headers))) abort("'headers' must be a named list") replicate(times, .data$to_return(status = z$status, body = z$body, headers = z$headers)) return(.data) diff --git a/R/webmockr-package.R b/R/webmockr-package.R index 4dd522b..48fdf2b 100644 --- a/R/webmockr-package.R +++ b/R/webmockr-package.R @@ -22,5 +22,6 @@ #' @importFrom fauxpas HTTPRequestTimeout #' @importFrom crul mock #' @importFrom base64enc base64encode +#' @importFrom rlang abort check_installed ## usethis namespace: end NULL diff --git a/R/wi_th.R b/R/wi_th.R index 6416827..e49a1d0 100644 --- a/R/wi_th.R +++ b/R/wi_th.R @@ -100,13 +100,13 @@ wi_th <- function(.data, ..., .list = list()) { !any(c("query", "body", "headers", "basic_auth") %in% names(z)) && length(z) != 0 ) { - stop("'wi_th' only accepts query, body, headers, basic_auth") + abort("'wi_th' only accepts query, body, headers, basic_auth") } - if (any(duplicated(names(z)))) stop("can not have duplicated names") + if (any(duplicated(names(z)))) abort("can not have duplicated names") assert(z$query, c("list", "partial")) - if (!all(hz_namez(z$query))) stop("'query' must be a named list") + if (!all(hz_namez(z$query))) abort("'query' must be a named list") assert(z$headers, "list") - if (!all(hz_namez(z$headers))) stop("'headers' must be a named list") + if (!all(hz_namez(z$headers))) abort("'headers' must be a named list") assert(z$basic_auth, "character") assert_eq(z$basic_auth, 2) .data$with( diff --git a/R/zzz.R b/R/zzz.R index 0f014ae..bb1503e 100644 --- a/R/zzz.R +++ b/R/zzz.R @@ -214,15 +214,6 @@ hz_namez <- function(x) { } } -# check for a package -check_for_pkg <- function(x) { - if (!requireNamespace(x, quietly = TRUE)) { - stop(sprintf("Please install '%s'", x), call. = FALSE) - } else { - invisible(TRUE) - } -} - # lower case names in a list, return that list names_to_lower <- function(x) { names(x) <- tolower(names(x)) diff --git a/tests/testthat/test-Adapter.R b/tests/testthat/test-Adapter.R index 0ee506d..ab9a4d2 100644 --- a/tests/testthat/test-Adapter.R +++ b/tests/testthat/test-Adapter.R @@ -3,7 +3,17 @@ context("Adapter class") test_that("Adapter class can't be instantiated", { expect_is(Adapter, "R6ClassGenerator") expect_error( - Adapter$new(), + Adapter$new(), "Adapter parent class should not be called directly" ) }) + +test_that("Adapter initialize method errors as expected", { + adap <- R6::R6Class("CrulAdapter", + inherit = Adapter, + public = list( + client = NULL + ) + ) + expect_error(adap$new(), "should not be called directly") +}) diff --git a/tests/testthat/test-to_return_body.R b/tests/testthat/test-to_return_body.R index bdc0f52..c2f90af 100644 --- a/tests/testthat/test-to_return_body.R +++ b/tests/testthat/test-to_return_body.R @@ -55,6 +55,6 @@ test_that("to_return: setting body with wrong type errors well", { expect_error( stub_request("get", "https://google.com") %>% to_return(body = TRUE), - "Unknown type of `body`" + "Unknown `body` type" ) })