Skip to content

refactor(epidatacall): remove fetch_csv and use testthat mocking #115

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Merged
merged 5 commits into from
May 31, 2023
Merged

refactor(epidatacall): remove fetch_csv and use testthat mocking #115

Show file tree
Hide file tree
Changes from 3 commits
Commits
Show all changes
5 commits
Select commit Hold shift + click to select a range
f8e21c7
refactor(epidatacall):
dshemetov May 26, 2023
1da2ee4
docs: doc
dshemetov May 26, 2023
2f9464a
Update tests/testthat/test-epidatacall.R
dshemetov May 27, 2023
0b3fae2
bug(test): correctly mock requests
dshemetov May 31, 2023
e8ae92a
style: styler
dshemetov May 31, 2023
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
2 changes: 0 additions & 2 deletions DESCRIPTION
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -34,8 +34,6 @@ RoxygenNote: 7.2.3
Suggests:
dplyr,
knitr,
mockery,
mockr,
rmarkdown,
testthat (>= 3.1.5),
withr
Expand Down
1 change: 0 additions & 1 deletion NAMESPACE
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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)
Expand Down
100 changes: 0 additions & 100 deletions R/epidatacall.R
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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")
Expand Down Expand Up @@ -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
}
35 changes: 0 additions & 35 deletions man/fetch_csv.Rd
View file
Open in desktop

This file was deleted.

55 changes: 24 additions & 31 deletions tests/testthat/test-epidatacall.R
View file
Open in desktop
Original file line number Diff line number Diff line change
@@ -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",
Expand All @@ -7,32 +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)
# This test compares the output of a tibble using fetch and fetch_tbl.
with_mocked_bindings(
Copy link
Contributor

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

When I run this locally with no internet connection, its hanging. This makes me think content isn't being mocked and the test is just calling the server.

Copy link
Contributor Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

thanks for pointing this out. the problem was that I was mocking httr::content, which parse the response, but i didnt mock epidatr::request_impl, which was still making a request (even though the request wasn't being used).

{
tbl_out <- epidata_call %>% fetch_tbl()
out <- epidata_call %>% fetch()
},
# 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.
out <- epidata_call %>% fetch()
expect_identical(out, tbl_out)
})

Expand All @@ -50,11 +39,15 @@ test_that("fetch_tbl warns on non-success", {
# see generation code above
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)
expect_warning(epidata_call %>% fetch_tbl(),
regexp = paste0("epidata warning: ", artificial_warning),
fixed = TRUE
`[[<-`("message", artificial_warning)
with_mocked_bindings(
{
expect_warning(epidata_call %>% fetch_tbl(),
regexp = paste0("epidata warning: ", artificial_warning),
fixed = TRUE
)
},
fromJSON = function(...) debug_response_content_triplet,
.package = "jsonlite"
)
})