Merge pull request #115 from cmu-delphi/ds/testthat

refactor(epidatacall): remove `fetch_csv` and use `testthat` mocking

Author: dshemetov

DESCRIPTION

@@ -34,8 +34,6 @@ RoxygenNote: 7.2.3
 Suggests:
     dplyr,
     knitr,
-    mockery,
-    mockr,
     rmarkdown,
     testthat (>= 3.1.5),
     withr

NAMESPACE

@@ -6,7 +6,6 @@ S3method(print,covidcast_data_signal)
 S3method(print,covidcast_data_source)
 S3method(print,covidcast_epidata)
 S3method(print,epidata_call)
-S3method(print,epidata_csv)
 export("%>%")
 export(covid_hosp_facility)
 export(covid_hosp_facility_lookup)

R/epidatacall.R

@@ -195,72 +195,6 @@ fetch_classic <- function(epidata_call, fields = NULL, disable_data_frame_parsin
   return(response_content$epidata)
 }
 
-#' Fetches the data and returns a tibble or an `epidata_csv`
-#'
-#' @param epidata_call an instance of `epidata_call`
-#' @param fields filter fields
-#' @param disable_date_parsing Boolean. Optionally, `TRUE` to disable parsing of
-#'   columns we expect to be dates, keeping them as character columns instead.
-#'   `FALSE` (the default) to parse these columns into `Date` vectors.
-#' @param disable_tibble_output Boolean. Optionally, `TRUE` to output a
-#'   character vector with the `epidata_csv` class (which provides a custom
-#'   `print` method). `FALSE` (the default) to output a tibble.
-#' @return
-#' - For `fetch_csv`: a tibble, or `epidata_csv` if requested with
-#'   `disable_tibble_output = TRUE`
-#'
-#' @importFrom httr stop_for_status content
-#' @importFrom rlang abort
-fetch_csv <- function(epidata_call, fields = NULL, disable_date_parsing = FALSE, disable_tibble_output = FALSE) {
-  stopifnot(inherits(epidata_call, "epidata_call"))
-  stopifnot(is.null(fields) || is.character(fields))
-
-  if (epidata_call$only_supports_classic) {
-    rlang::abort("This endpoint only supports the classic message format, due to a non-standard behavior. Use fetch_classic instead.",
-      epidata_call = epidata_call,
-      class = "only_supports_classic_format"
-    )
-  }
-
-  response <- request_impl(epidata_call, "csv", fields)
-  response_content <- httr::content(response, "text", encoding = "UTF-8")
-  class(response_content) <- c("epidata_csv", class(response_content))
-
-  if (disable_tibble_output) {
-    return(response_content)
-  }
-
-  meta <- epidata_call$meta
-  fields_pred <- fields_to_predicate(fields)
-  col_names <- c()
-  col_types <- list()
-  for (i in seq_len(length(meta))) {
-    info <- meta[[i]]
-    if (fields_pred(info$name)) {
-      col_names <- c(col_names, info$name)
-      col_types[info$name] <- info_to_type(info, disable_date_parsing)
-    }
-  }
-
-  csv_tibble <- if (length(col_names) > 0) {
-    readr::read_csv(response_content, col_types = col_types)
-  } else {
-    readr::read_csv(response_content)
-  }
-
-  if (!disable_date_parsing) {
-    # parse weeks
-    columns <- colnames(csv_tibble)
-    for (i in seq_len(length(meta))) {
-      info <- meta[[i]]
-      if (info$name %in% columns && info$type == "epiweek") {
-        csv_tibble[[info$name]] <- parse_api_week(csv_tibble[[info$name]])
-      }
-    }
-  }
-  csv_tibble
-}
-
 fetch_debug <- function(epidata_call, format_type = "classic", fields = NULL) {
   response <- request_impl(epidata_call, format_type, fields)
   content <- httr::content(response, "text", encoding = "UTF-8")
@@ -334,37 +268,3 @@ request_impl <- function(epidata_call, format_type, fields = NULL) {
 
   response
 }
-
-#' @export
-print.epidata_csv <- function(x, ...) {
-  char_limit <- getOption("epidata_csv__char_limit", default = 300L)
-  cat(
-    "# A epidata_csv object with", nchar(x), "characters; showing up to", char_limit,
-    "characters below. To print the entire string, use `print(as.character(x))`:\n"
-  )
-  cat(substr(x, 1L, char_limit))
-  if (nchar(x) > char_limit) {
-    cat("[...]")
-  }
-  cat("\n")
-  invisible(x)
-}
-
-info_to_type <- function(info, disable_date_parsing = FALSE) {
-  types <- list(
-    date = if (disable_date_parsing) {
-      readr::col_integer()
-    } else {
-      readr::col_date(format = "%Y%m%d")
-    },
-    epiweek = readr::col_integer(),
-    bool = readr::col_logical(),
-    text = readr::col_character(),
-    int = readr::col_integer(),
-    float = readr::col_double(),
-    categorical = readr::col_factor(info$categories)
-  )
-  r <- types[info$type]
-  stopifnot(!is.null(r))
-  r
-}

man/fetch_csv.Rd

@@ -1,4 +1,4 @@
-test_that("fetch_tbl", {
+test_that("fetch and fetch_tbl", {
   epidata_call <- covidcast(
     data_source = "jhu-csse",
     signals = "confirmed_7dav_incidence_prop",
@@ -7,31 +7,21 @@ test_that("fetch_tbl", {
     time_values = epirange("2020-06-01", "2020-08-01"),
     geo_values = "ca,fl"
   )
-  # Generated with
-  # epidata_call %>%
-  # fetch_debug(format_type = "classic") %>%
-  # readr::write_rds(testthat::test_path("data/test-classic.rds"))
-  mockery::stub(fetch_classic, "httr::content", readRDS(testthat::test_path("data/test-classic.rds")))
-  mockery::stub(fetch_tbl, "fetch_classic", fetch_classic)
-  # Generated with
-  # epidata_call %>%
-  # fetch_debug(format_type = "csv") %>%
-  # readr::write_rds(testthat::test_path("data/test-csv.rds"))
-  mockery::stub(fetch_csv, "httr::content", readRDS(testthat::test_path("data/test-csv.rds")))
 
-  # This test compares the output of a tibble using fetch_tbl and fetch_csv.
-  #
-  # 1) fetch_tbl calls fetch_classic, which requests the default (classic
-  # format) from the API, uses jsonlite::fromJSON to convert the underlying data
-  # to a data.frame, and finally applies parse_data_frame is used to do the data
-  # type coersion specified by the epidata_call metadata.
-  # 2) fetch_csv requests the csv format from the API, then uses readr::read_csv
-  # to get a data.frame, and has its own methods to enforce data types.
-  tbl_out <- epidata_call %>% fetch_tbl()
-  csv_out <- epidata_call %>% fetch_csv()
-  expect_identical(tbl_out, csv_out)
+  local_mocked_bindings(
+    request_impl = function(...) NULL,
+    .package = "epidatr"
+  )
+  local_mocked_bindings(
+    # RDS file generated with
+    # epidata_call %>%
+    # fetch_debug(format_type = "classic") %>%
+    # readr::write_rds(testthat::test_path("data/test-classic.rds"))
+    content = function(...) readRDS(testthat::test_path("data/test-classic.rds")),
+    .package = "httr"
+  )
 
-  # # This test compares fetch_tbl with the output of fetch, which should be identical.
+  tbl_out <- epidata_call %>% fetch_tbl()
   out <- epidata_call %>% fetch()
   expect_identical(out, tbl_out)
 })
@@ -45,14 +35,25 @@ test_that("fetch_tbl warns on non-success", {
     time_values = epirange("2020-06-01", "2020-08-01"),
     geo_values = "ca,fl"
   )
+
+  local_mocked_bindings(
+    request_impl = function(...) NULL,
+    .package = "epidatr"
+  )
+  local_mocked_bindings(
+    content = function(...) NULL,
+    .package = "httr"
+  )
   artificial_warning <- "* This is a warning with a leading asterisk and {braces} to make sure we don't have bulleting/glue bugs."
-  debug_response_content_triplet <-
-    # see generation code above
-    readRDS(testthat::test_path("data/test-classic.rds")) %>%
+  debug_triplet <- readRDS(testthat::test_path("data/test-classic.rds")) %>%
     jsonlite::fromJSON() %>%
-    `[[<-`("message", "* This is a warning with a leading asterisk and {braces} to make sure we don't have bulleting/glue bugs.")
-  mockery::stub(fetch_classic, "jsonlite::fromJSON", debug_response_content_triplet)
-  mockery::stub(fetch_tbl, "fetch_classic", fetch_classic)
+    `[[<-`("message", artificial_warning)
+  local_mocked_bindings(
+    # see generation code above
+    fromJSON = function(...) debug_triplet,
+    .package = "jsonlite"
+  )
+
   expect_warning(epidata_call %>% fetch_tbl(),
     regexp = paste0("epidata warning: ", artificial_warning),
     fixed = TRUE