styling

ropensci · Oct 8, 2024 · 34466dd · 34466dd
1 parent 0433fa6
commit 34466dd
Show file tree

Hide file tree

Showing 11 changed files with 377 additions and 237 deletions.
diff --git a/R/RequestPattern.R b/R/RequestPattern.R
diff --git a/R/StubbedRequest.R b/R/StubbedRequest.R
@@ -13,7 +13,7 @@
 #' x$put(z)
 #' x$count()
 StubCounter <- R6::R6Class(
-  'StubCounter',
+  "StubCounter",
   public = list(
     #' @field hash (list) a list for internal use only, with elements
     #' `key`, `sig`, and `count`
@@ -48,11 +48,11 @@ StubCounter <- R6::R6Class(
 #' x <- StubbedRequest$new(method = "get", uri = "api.crossref.org")
 #' x$method
 #' x$uri
-#' x$with(headers = list('User-Agent' = 'R', apple = "good"))
+#' x$with(headers = list("User-Agent" = "R", apple = "good"))
 #' x$to_return(status = 200, body = "foobar", headers = list(a = 5))
 #' x
 #' x$to_s()
-#' 
+#'
 #' # query
 #' x <- StubbedRequest$new(method = "get", uri = "httpbin.org")
 #' x$with(query = list(a = 5))
@@ -85,8 +85,10 @@ StubCounter <- R6::R6Class(
 #' x
 #'
 #' x <- StubbedRequest$new(method = "get", uri = "api.crossref.org")
-#' x$to_return(status = 200, body = charToRaw("foo bar"),
-#'   headers = list(a = 5))
+#' x$to_return(
+#'   status = 200, body = charToRaw("foo bar"),
+#'   headers = list(a = 5)
+#' )
 #' x$to_s()
 #' x
 #'
@@ -108,8 +110,10 @@ StubCounter <- R6::R6Class(
 #' #   payload written to file during mocked response creation
 #' x <- StubbedRequest$new(method = "get", uri = "api.crossref.org")
 #' f <- tempfile()
-#' x$to_return(status = 200, body = mock_file(f, "{\"foo\": \"bar\"}"),
-#'   headers = list(a = 5))
+#' x$to_return(
+#'   status = 200, body = mock_file(f, "{\"foo\": \"bar\"}"),
+#'   headers = list(a = 5)
+#' )
 #' x
 #' x$to_s()
 #' unlink(f)
@@ -201,30 +205,47 @@ StubbedRequest <- R6::R6Class(
       cat(paste0("  uri: ", self$uri %||% self$uri_regex), sep = "\n")
       cat("  with: ", sep = "\n")
       cat(paste0("    query: ", hdl_lst(self$query)), sep = "\n")
-      if (is.null(self$body))
+      if (is.null(self$body)) {
         cat("    body: ", sep = "\n")
-      else
-        cat(sprintf("    body (class: %s): %s", class(self$body)[1L],
-          hdl_lst(self$body)), sep = "\n")
-      cat(paste0("    request_headers: ",
-        hdl_lst(self$request_headers)),
-          sep = "\n")
+      } else {
+        cat(sprintf(
+          "    body (class: %s): %s", class(self$body)[1L],
+          hdl_lst(self$body)
+        ), sep = "\n")
+      }
+      cat(
+        paste0(
+          "    request_headers: ",
+          hdl_lst(self$request_headers)
+        ),
+        sep = "\n"
+      )
       cat("  to_return: ", sep = "\n")
       rs <- self$responses_sequences
       for (i in seq_along(rs)) {
         cat(paste0("  - status: ", hdl_lst(rs[[i]]$status)),
-            sep = "\n")
+          sep = "\n"
+        )
         cat(paste0("    body: ", hdl_lst(rs[[i]]$body)),
-            sep = "\n")
-        cat(paste0("    response_headers: ",
-          hdl_lst(rs[[i]]$headers)),
-            sep = "\n")
+          sep = "\n"
+        )
+        cat(
+          paste0(
+            "    response_headers: ",
+            hdl_lst(rs[[i]]$headers)
+          ),
+          sep = "\n"
+        )
         cat(paste0("    should_timeout: ", rs[[i]]$timeout), sep = "\n")
-        cat(paste0("    should_raise: ",
-          if (rs[[i]]$raise)
+        cat(paste0(
+          "    should_raise: ",
+          if (rs[[i]]$raise) {
             paste0(vapply(rs[[i]]$exceptions, "[[", "", "classname"),
-              collapse = ", ")
-          else "FALSE"
+              collapse = ", "
+            )
+          } else {
+            "FALSE"
+          }
         ), sep = "\n")
       }
     },
@@ -243,7 +264,7 @@ StubbedRequest <- R6::R6Class(
       self$body <- body
       self$basic_auth <- basic_auth
       if (!is.null(basic_auth)) {
-        headers <- c(prep_auth(paste0(basic_auth, collapse = ':')), headers)
+        headers <- c(prep_auth(paste0(basic_auth, collapse = ":")), headers)
       }
       self$request_headers <- headers
     },
@@ -259,8 +280,9 @@ StubbedRequest <- R6::R6Class(
       body <- if (inherits(body, "connection")) {
         bod_sum <- summary(body)
         close.connection(body)
-        if (bod_sum$class != "file")
+        if (bod_sum$class != "file") {
           stop("'to_return' only supports connections of type 'file'")
+        }
         structure(bod_sum$description, type = "file")
       } else {
         body
@@ -274,9 +296,13 @@ 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)
+            stop(
+              paste0(
+                "Unknown type of `body`: ",
+                "must be NULL, FALSE, character, raw or list; stub removed"
+              ),
+              call. = FALSE
+            )
           }
         } else if (inherits(body, "raw")) {
           body
@@ -291,10 +317,14 @@ 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)
+          stop(
+            paste0(
+              "Unknown type of `body`: ",
+              "must be numeric, NULL, FALSE, character, json, ",
+              "raw, list, or file connection; stub removed"
+            ),
+            call. = FALSE
+          )
         } else {
           charToRaw(jsonlite::toJSON(body, auto_unbox = TRUE))
         }
@@ -344,14 +374,20 @@ StubbedRequest <- R6::R6Class(
             bd <- make_body(ret[[i]]$body)
             stt <- make_status(ret[[i]]$status)
             hed <- make_headers(ret[[i]]$headers)
-            strgs[i] <- sprintf("%s %s %s",
+            strgs[i] <- sprintf(
+              "%s %s %s",
               if (nzchar(paste0(bd, stt, hed))) paste("| to_return: ", bd, stt, hed) else "",
               if (ret[[i]]$timeout) "| should_timeout: TRUE" else "",
-              if (ret[[i]]$raise)
-                paste0("| to_raise: ",
+              if (ret[[i]]$raise) {
+                paste0(
+                  "| to_raise: ",
                   paste0(vapply(ret[[i]]$exceptions, "[[", "", "classname"),
-                  collapse = ", "))
-              else ""
+                    collapse = ", "
+                  )
+                )
+              } else {
+                ""
+              }
             )
           }
           paste0(strgs, collapse = " ")
@@ -367,14 +403,12 @@ StubbedRequest <- R6::R6Class(
       self$counter <- StubCounter$new()
     }
   ),
-
   private = list(
     append_response = function(x) {
       self$responses_sequences <- cc(c(self$responses_sequences, list(x)))
     },
     response = function(status = NULL, body = NULL, headers = NULL,
-      body_raw = NULL, timeout = FALSE, raise = FALSE, exceptions = list()
-    ) {
+                        body_raw = NULL, timeout = FALSE, raise = FALSE, exceptions = list()) {
       list(
         status = status,
         body = body,
@@ -395,7 +429,9 @@ basic_auth_header <- function(x) {
   return(paste0("Basic ", encoded))
 }
 prep_auth <- function(x) {
-  if (is.null(x)) return(NULL)
+  if (is.null(x)) {
+    return(NULL)
+  }
   if (!is.null(x)) {
     list(Authorization = basic_auth_header(x))
   }

diff --git a/R/stub_request.R b/R/stub_request.R
@@ -56,22 +56,23 @@
 #'
 #' # request headers
 #' stub_request("get", "https://httpbin.org/get") %>%
-#'    wi_th(headers = list('User-Agent' = 'R'))
+#'   wi_th(headers = list("User-Agent" = "R"))
 #'
 #' # request body
 #' stub_request("post", "https://httpbin.org/post") %>%
-#'    wi_th(body = list(foo = 'bar'))
+#'   wi_th(body = list(foo = "bar"))
 #' stub_registry()
 #' library(crul)
 #' x <- crul::HttpClient$new(url = "https://httpbin.org")
 #' crul::mock()
-#' x$post('post', body = list(foo = 'bar'))
+#' x$post("post", body = list(foo = "bar"))
 #'
 #' # add expectation with to_return
 #' stub_request("get", "https://httpbin.org/get") %>%
 #'   wi_th(
 #'     query = list(hello = "world"),
-#'     headers = list('User-Agent' = 'R')) %>%
+#'     headers = list("User-Agent" = "R")
+#'   ) %>%
 #'   to_return(status = 200, body = "stuff", headers = list(a = 5))
 #'
 #' # list stubs again
@@ -83,7 +84,7 @@
 #' # set stub an expectation to timeout
 #' stub_request("get", "https://httpbin.org/get") %>% to_timeout()
 #' x <- crul::HttpClient$new(url = "https://httpbin.org")
-#' res <- x$get('get')
+#' res <- x$get("get")
 #'
 #' # raise exception
 #' library(fauxpas)
@@ -93,39 +94,40 @@
 #' x <- crul::HttpClient$new(url = "https://httpbin.org")
 #' stub_request("get", "https://httpbin.org/get") %>% to_raise(HTTPBadGateway)
 #' crul::mock()
-#' x$get('get')
+#' x$get("get")
 #'
 #' # pass a list to .list
 #' z <- stub_request("get", "https://httpbin.org/get")
 #' wi_th(z, .list = list(query = list(foo = "bar")))
 #'
 #' # just body
 #' stub_request("any", uri_regex = ".+") %>%
-#'    wi_th(body = list(foo = 'bar'))
+#'   wi_th(body = list(foo = "bar"))
 #' ## with crul
 #' library(crul)
 #' x <- crul::HttpClient$new(url = "https://httpbin.org")
 #' crul::mock()
-#' x$post('post', body = list(foo = 'bar'))
-#' x$put('put', body = list(foo = 'bar'))
+#' x$post("post", body = list(foo = "bar"))
+#' x$put("put", body = list(foo = "bar"))
 #' ## with httr
 #' library(httr)
 #' httr_mock()
-#' POST('https://example.com', body = list(foo = 'bar'))
-#' PUT('https://google.com', body = list(foo = 'bar'))
+#' POST("https://example.com", body = list(foo = "bar"))
+#' PUT("https://google.com", body = list(foo = "bar"))
 #'
 #'
 #' # just headers
 #' headers <- list(
-#'   'Accept-Encoding' = 'gzip, deflate',
-#'   'Accept' = 'application/json, text/xml, application/xml, */*')
+#'   "Accept-Encoding" = "gzip, deflate",
+#'   "Accept" = "application/json, text/xml, application/xml, */*"
+#' )
 #' stub_request("any", uri_regex = ".+") %>% wi_th(headers = headers)
 #' library(crul)
 #' x <- crul::HttpClient$new(url = "https://httpbin.org", headers = headers)
 #' crul::mock()
-#' x$post('post')
-#' x$put('put', body = list(foo = 'bar'))
-#' x$get('put', query = list(stuff = 3423234L))
+#' x$post("post")
+#' x$put("put", body = list(foo = "bar"))
+#' x$get("put", query = list(stuff = 3423234L))
 #'
 #' # many responses
 #' ## the first response matches the first to_return call, and so on
@@ -150,15 +152,15 @@
 #' library(httr)
 #' ## matches
 #' stub_request("get", "https://hb.opencpu.org/get") %>%
-#'  wi_th(query = including(list(fruit = "pear"))) %>%
-#'  to_return(body = "matched on partial query!")
+#'   wi_th(query = including(list(fruit = "pear"))) %>%
+#'   to_return(body = "matched on partial query!")
 #' resp <- GET("https://hb.opencpu.org/get", query = list(fruit = "pear"))
 #' rawToChar(content(resp))
 #' ## doesn't match
 #' stub_registry_clear()
 #' stub_request("get", "https://hb.opencpu.org/get") %>%
-#'  wi_th(query = list(fruit = "pear")) %>%
-#'  to_return(body = "didn't match, ugh!")
+#'   wi_th(query = list(fruit = "pear")) %>%
+#'   to_return(body = "didn't match, ugh!")
 #' # GET("https://hb.opencpu.org/get", query = list(fruit = "pear", meat = "chicken"))
 #'
 #' # clear all stubs

diff --git a/R/wi_th.R b/R/wi_th.R
@@ -5,7 +5,7 @@
 #' @export
 #' @param .data input. Anything that can be coerced to a `StubbedRequest` class
 #' object
-#' @param ... Comma separated list of named variables. accepts the following: 
+#' @param ... Comma separated list of named variables. accepts the following:
 #' `query`, `body`, `headers`, `basic_auth`. See Details.
 #' @param .list named list, has to be one of `query`, `body`,
 #' `headers` and/or `basic_auth`. An alternative to passing in via `...`.
@@ -17,7 +17,7 @@
 #' the stub
 #' @note see more examples in [stub_request()]
 #' @seealso [including()]
-#' @details 
+#' @details
 #' Values for query, body, headers, and basic_auth:
 #'
 #' - query: (list) a named list. values are coerced to character
@@ -32,12 +32,12 @@
 #' mocking authenciation right now does not take into account the
 #' authentication type. We don't do any checking of the username/password
 #' except to detect edge cases where for example, the username/password
-#' were probably not set by the user on purpose (e.g., a URL is 
+#' were probably not set by the user on purpose (e.g., a URL is
 #' picked up by an environment variable)
-#' 
+#'
 #' Note that there is no regex matching on query, body, or headers. They
 #' are tested for matches in the following ways:
-#' 
+#'
 #' - query: compare stubs and requests with `identical()`. this compares
 #' named lists, so both list names and values are compared
 #' - body: varies depending on the body format (list vs. character, etc.)
@@ -67,21 +67,21 @@
 #'
 #' # add headers - has to be a named list
 #' wi_th(req, headers = list(foo = "bar"))
-#' wi_th(req, headers = list(`User-Agent` = "webmockr/v1", hello="world"))
+#' wi_th(req, headers = list(`User-Agent` = "webmockr/v1", hello = "world"))
 #'
 #' # .list - pass in a named list instead
 #' wi_th(req, .list = list(body = list(foo = "bar")))
-#' 
+#'
 #' # basic authentication
 #' wi_th(req, basic_auth = c("user", "pass"))
 #' wi_th(req, basic_auth = c("user", "pass"), headers = list(foo = "bar"))
-#' 
+#'
 #' # partial matching, query params
 #' ## including
 #' wi_th(req, query = including(list(foo = "bar")))
 #' ## excluding
 #' wi_th(req, query = excluding(list(foo = "bar")))
-#' 
+#'
 #' # partial matching, body
 #' ## including
 #' wi_th(req, body = including(list(foo = "bar")))
@@ -95,7 +95,7 @@ wi_th <- function(.data, ..., .list = list()) {
   z <- c(z, .list)
   if (
     !any(c("query", "body", "headers", "basic_auth") %in% names(z)) &&
-    length(z) != 0
+      length(z) != 0
   ) {
     stop("'wi_th' only accepts query, body, headers, basic_auth")
   }