diff --git a/DESCRIPTION b/DESCRIPTION index ddba9cce..777b6ecd 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -34,8 +34,6 @@ RoxygenNote: 7.2.3 Suggests: dplyr, knitr, - mockery, - mockr, rmarkdown, testthat (>= 3.1.5), withr diff --git a/NAMESPACE b/NAMESPACE index c29b64df..cbe41ffd 100644 --- a/NAMESPACE +++ b/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) diff --git a/R/epidatacall.R b/R/epidatacall.R index 40332479..69cf5a61 100644 --- a/R/epidatacall.R +++ b/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 -} diff --git a/man/fetch_csv.Rd b/man/fetch_csv.Rd deleted file mode 100644 index 3def231b..00000000 --- a/man/fetch_csv.Rd +++ /dev/null @@ -1,35 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/epidatacall.R -\name{fetch_csv} -\alias{fetch_csv} -\title{Fetches the data and returns a tibble or an \code{epidata_csv}} -\usage{ -fetch_csv( - epidata_call, - fields = NULL, - disable_date_parsing = FALSE, - disable_tibble_output = FALSE -) -} -\arguments{ -\item{epidata_call}{an instance of \code{epidata_call}} - -\item{fields}{filter fields} - -\item{disable_date_parsing}{Boolean. Optionally, \code{TRUE} to disable parsing of -columns we expect to be dates, keeping them as character columns instead. -\code{FALSE} (the default) to parse these columns into \code{Date} vectors.} - -\item{disable_tibble_output}{Boolean. Optionally, \code{TRUE} to output a -character vector with the \code{epidata_csv} class (which provides a custom -\code{print} method). \code{FALSE} (the default) to output a tibble.} -} -\value{ -\itemize{ -\item For \code{fetch_csv}: a tibble, or \code{epidata_csv} if requested with -\code{disable_tibble_output = TRUE} -} -} -\description{ -Fetches the data and returns a tibble or an \code{epidata_csv} -} diff --git a/tests/testthat/test-epidatacall.R b/tests/testthat/test-epidatacall.R index c5502c22..30d5d835 100644 --- a/tests/testthat/test-epidatacall.R +++ b/tests/testthat/test-epidatacall.R @@ -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