From 6ea7198ed6453c2e88d6d3349e6e6effdf638cf3 Mon Sep 17 00:00:00 2001 From: Dmitry Shemetov Date: Tue, 4 Feb 2025 20:15:31 -0800 Subject: [PATCH 1/2] feat: add refresh_cache to fetch_args_list * fix: only_supports_classic was parsed incorrectly * fix: clear_cache reuses previous set_cache settings * feat: add is_cache_enabled() * refactor: cache_epidata_call integrated into fetch() * refactor: removed fetch_tbl() and integrated into fetch() * test: fix cache tests to not clear user cache * ci: update old actions * doc: comment cacheable functions --- .github/workflows/test-coverage.yml | 2 +- DESCRIPTION | 6 +- NAMESPACE | 2 +- NEWS.md | 1 + R/cache.R | 143 +++++++++++------- R/epidatacall.R | 75 +++++---- R/utils.R | 20 --- ...ta_call.Rd => check_for_cache_warnings.Rd} | 11 +- man/check_is_cachable.Rd | 17 ++- man/clear_cache.Rd | 6 +- man/covidcast_epidata.Rd | 4 +- man/fetch_args_list.Rd | 6 +- man/fetch_tbl.Rd | 22 --- man/is_cache_enabled.Rd | 12 ++ tests/testthat/test-cache.R | 62 +++++--- tests/testthat/test-epidatacall.R | 39 +++-- 16 files changed, 239 insertions(+), 189 deletions(-) rename man/{cache_epidata_call.Rd => check_for_cache_warnings.Rd} (55%) delete mode 100644 man/fetch_tbl.Rd create mode 100644 man/is_cache_enabled.Rd diff --git a/.github/workflows/test-coverage.yml b/.github/workflows/test-coverage.yml index 8884f538..74ccb483 100644 --- a/.github/workflows/test-coverage.yml +++ b/.github/workflows/test-coverage.yml @@ -53,4 +53,4 @@ jobs: path: ${{ runner.temp }}/package - name: Upload coverage reports to Codecov - uses: codecov/codecov-action@v3 + uses: codecov/codecov-action@v5 diff --git a/DESCRIPTION b/DESCRIPTION index ba19419e..ef9dafc8 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -30,7 +30,7 @@ URL: https://cmu-delphi.github.io/epidatr/, https://cmu-delphi.github.io/delphi-epidata/, https://github.com/cmu-delphi/epidatr BugReports: https://github.com/cmu-delphi/epidatr/issues -Depends: +Depends: R (>= 3.5.0) Imports: cachem, @@ -58,9 +58,9 @@ Suggests: rmarkdown, testthat (>= 3.1.5), withr -VignetteBuilder: +VignetteBuilder: knitr -Remotes: +Remotes: cmu-delphi/delphidocs Config/Needs/website: cmu-delphi/delphidocs Config/testthat/edition: 3 diff --git a/NAMESPACE b/NAMESPACE index c6fed522..e902af3b 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -53,6 +53,7 @@ import(cachem) import(glue) importFrom(MMWRweek,MMWRweek) importFrom(MMWRweek,MMWRweek2Date) +importFrom(cachem,is.key_missing) importFrom(checkmate,assert) importFrom(checkmate,assert_character) importFrom(checkmate,assert_integerish) @@ -80,7 +81,6 @@ importFrom(magrittr,"%>%") importFrom(openssl,md5) importFrom(purrr,map_chr) importFrom(purrr,map_lgl) -importFrom(readr,read_csv) importFrom(stats,na.omit) importFrom(tibble,as_tibble) importFrom(tibble,tibble) diff --git a/NEWS.md b/NEWS.md index f9317324..38c3c8b5 100644 --- a/NEWS.md +++ b/NEWS.md @@ -12,6 +12,7 @@ - Support more date formats in function to convert dates to epiweeks. Use `parse_api_date` since it already supports both common formats. #276 - `EPIDATR_USE_CACHE` only supported exactly "TRUE" before. Now it supports all logical values and includes a warning when any value that can't be converted to logical is provided. #273 - `missing` doesn't count default values as non-missing. If a user doesn't pass `geo_values` or `time_values` (both of which default to `"*"` in `pub_covidcast`), or `dates` (in `pub_covid_hosp_state_timeseries`), the missing check fails. To avoid this, just don't check missingness of those two arguments. +- `fetch_args_list` now has an `refresh_cache` argument, which is `FALSE` by default. # epidatr 1.1.1 diff --git a/R/cache.R b/R/cache.R index bc30b48f..b6d3f04f 100644 --- a/R/cache.R +++ b/R/cache.R @@ -3,6 +3,7 @@ cache_environ <- new.env(parent = emptyenv()) cache_environ$use_cache <- NULL cache_environ$epidatr_cache <- NULL +cache_environ$cache_args <- NULL #' Create or renew a cache for this session #' @aliases set_cache @@ -169,6 +170,12 @@ set_cache <- function(cache_dir = NULL, max_age = days * 24 * 60 * 60, logfile = file.path(cache_dir, logfile) ) + cache_environ$cache_args <- list2( + cache_dir = cache_dir, + days = days, + max_size = max_size, + logfile = logfile + ) } cli::cli_inform(c( @@ -183,9 +190,9 @@ set_cache <- function(cache_dir = NULL, #' Manually reset the cache, deleting all currently saved data and starting afresh #' @description #' Deletes the current cache and resets a new cache. Deletes local data! If you -#' are using a session unique cache, you will have to pass the arguments you -#' used for `set_cache` earlier, otherwise the system-wide `.Renviron`-based -#' defaults will be used. +#' are using a session unique cache, the previous settings will be reused. If +#' you pass in new `set_cache` arguments, they will take precedence over the +#' previous settings. #' @param disable instead of setting a new cache, disable caching entirely; #' defaults to `FALSE` #' @inheritDotParams set_cache @@ -198,11 +205,22 @@ set_cache <- function(cache_dir = NULL, clear_cache <- function(..., disable = FALSE) { if (any(!is.na(cache_environ$epidatr_cache))) { cache_environ$epidatr_cache$destroy() + recovered_args <- cache_environ$cache_args + cache_environ$cache_args <- NULL + } else { + recovered_args <- list() } + args <- rlang::dots_list( + ..., + confirm = FALSE, + !!!recovered_args, + .homonyms = "first", + .ignore_empty = "all" + ) if (disable) { cache_environ$epidatr_cache <- NULL } else { - set_cache(...) + rlang::inject(set_cache(!!!args)) } } @@ -234,68 +252,85 @@ disable_cache <- function() { #' disable without deleting #' @export cache_info <- function() { - if (is.null(cache_environ$epidatr_cache)) { - return("there is no cache") - } else { + if (is_cache_enabled()) { return(cache_environ$epidatr_cache$info()) + } else { + return("there is no cache") } } -#' Dispatch caching +#' Check if the cache is enabled +#' @keywords internal +is_cache_enabled <- function() { + !is.null(cache_environ$epidatr_cache) +} + +#' Helper that checks whether a call is actually cachable +#' +#' The cacheable endpoints are those with `as_of` or `issues` parameters: +#' - pub_covidcast +#' - pub_covid_hosp_state_timeseries +#' - pub_ecdc_ili +#' - pub_flusurv +#' - pub_fluview_clinical +#' - pub_fluview +#' - pub_kcdc_ili +#' - pub_nidss_flu +#' - pub_paho_dengue +#' +#' @keywords internal +check_is_cachable <- function(epidata_call, fetch_args) { + as_of_cachable <- !is.null(epidata_call$params$as_of) && !identical(epidata_call$params$as_of, "*") + issues_cachable <- !is.null(epidata_call$params$issues) && !identical(epidata_call$params$issues, "*") + is_cachable <- ( + # Cache should be enabled + is_cache_enabled() && + # Call should be cachable + (as_of_cachable || issues_cachable) && + # This should not be a dry run + !fetch_args$dry_run && + # Base url should be null + is.null(fetch_args$base_url) && + # Don't cache debug calls + !fetch_args$debug && + # Format type should be json + fetch_args$format_type == "json" && + # Fields should be null + is.null(fetch_args$fields) && + # Disable date parsing should be false + !fetch_args$disable_date_parsing && + # Disable data frame parsing should be false + !fetch_args$disable_data_frame_parsing && + # Refresh cache should be false + fetch_args$refresh_cache == FALSE + ) + return(is_cachable) +} + +#' Check for warnings for the cache #' #' @description -#' The guts of caching, its interposed between fetch and the specific fetch -#' methods. Internal method only. +#' Adds warnings when arguments are potentially too recent to use with the cache. #' #' @param epidata_call the `epidata_call` object #' @param fetch_args the args list for fetch as generated by [`fetch_args_list()`] #' @keywords internal -#' @importFrom openssl md5 -cache_epidata_call <- function(epidata_call, fetch_args = fetch_args_list()) { - is_cachable <- check_is_cachable(epidata_call, fetch_args) - if (is_cachable) { - target <- request_url(epidata_call) - hashed <- md5(target) - cached <- cache_environ$epidatr_cache$get(hashed) - as_of_recent <- check_is_recent(epidata_call$params$as_of, 7) - issues_recent <- check_is_recent(epidata_call$params$issues, 7) - if (as_of_recent || issues_recent) { - cli::cli_warn( - c( - "Using cached results with `as_of` within the past week (or the future!). +check_for_cache_warnings <- function(epidata_call, fetch_args) { + as_of_recent <- check_is_recent(epidata_call$params$as_of, 7) + issues_recent <- check_is_recent(epidata_call$params$issues, 7) + if (as_of_recent || issues_recent) { + cli::cli_warn( + c( + "Using cached results with `as_of` within the past week (or the future!). This will likely result in an invalid cache. Consider", - "i" = "disabling the cache for this session with `disable_cache` or + "i" = "disabling the cache for this session with `disable_cache` or permanently with environmental variable `EPIDATR_USE_CACHE=FALSE`", - "i" = "setting `EPIDATR_CACHE_MAX_AGE_DAYS={Sys.getenv('EPIDATR_CACHE_MAX_AGE_DAYS + "i" = "setting `EPIDATR_CACHE_MAX_AGE_DAYS={Sys.getenv('EPIDATR_CACHE_MAX_AGE_DAYS ', unset = 1)}` to e.g. `3/24` (3 hours)." - ), - .frequency = "regularly", - .frequency_id = "cache timing issues", - class = "cache_recent_data" - ) - } - if (!is.key_missing(cached)) { - cli::cli_warn( - c( - "Loading from the cache at {cache_environ$epidatr_cache$info()$dir}; - see {cache_environ$epidatr_cache$info()$logfile} for more details." - ), - .frequency = "regularly", - .frequency_id = "using the cache", - class = "cache_access" - ) - return(cached[[1]]) - } - } - # need to actually get the data, since its either not in the cache or we're not caching - runtime <- system.time(if (epidata_call$only_supports_classic) { - fetched <- fetch_classic(epidata_call, fetch_args) - } else { - fetched <- fetch_tbl(epidata_call, fetch_args) - }) - # add it to the cache if appropriate - if (is_cachable) { - cache_environ$epidatr_cache$set(hashed, list(fetched, Sys.time(), runtime)) + ), + .frequency = "regularly", + .frequency_id = "cache timing issues", + class = "cache_recent_data" + ) } - return(fetched) } diff --git a/R/epidatacall.R b/R/epidatacall.R index 958e00aa..c97a6d16 100644 --- a/R/epidatacall.R +++ b/R/epidatacall.R @@ -154,6 +154,8 @@ print.epidata_call <- function(x, ...) { #' @param debug if `TRUE`, return the raw response from the API #' @param format_type the format to request from the API, one of classic, json, #' csv; this is only used by `fetch_debug`, and by default is `"json"` +#' @param refresh_cache if `TRUE`, ignore the cache, fetch the data from the +#' API, and update the cache, if it is enabled #' @return A `fetch_args` object containing all the specified options #' @export #' @aliases fetch_args @@ -168,7 +170,8 @@ fetch_args_list <- function( base_url = NULL, dry_run = FALSE, debug = FALSE, - format_type = c("json", "classic", "csv")) { + format_type = c("json", "classic", "csv"), + refresh_cache = FALSE) { rlang::check_dots_empty() assert_character(fields, null.ok = TRUE, any.missing = FALSE) @@ -180,6 +183,7 @@ fetch_args_list <- function( assert_logical(dry_run, null.ok = FALSE, len = 1L, any.missing = TRUE) assert_logical(debug, null.ok = FALSE, len = 1L, any.missing = FALSE) format_type <- match.arg(format_type) + assert_logical(refresh_cache, null.ok = FALSE, len = 1L, any.missing = FALSE) structure( list( @@ -191,7 +195,8 @@ fetch_args_list <- function( base_url = base_url, dry_run = dry_run, debug = debug, - format_type = format_type + format_type = format_type, + refresh_cache = refresh_cache ), class = "fetch_args" ) @@ -219,6 +224,9 @@ print.fetch_args <- function(x, ...) { #' - For `fetch`: a tibble or a JSON-like list #' @export #' @include cache.R +#' @importFrom openssl md5 +#' @importFrom cachem is.key_missing +#' @importFrom tibble tibble as_tibble #' fetch <- function(epidata_call, fetch_args = fetch_args_list()) { stopifnot(inherits(epidata_call, "epidata_call")) @@ -228,48 +236,49 @@ fetch <- function(epidata_call, fetch_args = fetch_args_list()) { epidata_call <- with_base_url(epidata_call, fetch_args$base_url) } + # Just display the epidata_call object, don't fetch the data if (fetch_args$dry_run) { return(epidata_call) } + # Just display the raw response from the API, don't parse if (fetch_args$debug) { return(fetch_debug(epidata_call, fetch_args)) } - cache_epidata_call(epidata_call, fetch_args = fetch_args) -} - -#' Fetches the data and returns a tibble -#' @rdname fetch_tbl -#' -#' @param epidata_call an instance of `epidata_call` -#' @param fetch_args a `fetch_args` object -#' @importFrom readr read_csv -#' @importFrom httr stop_for_status content -#' @importFrom tibble as_tibble tibble -#' @return -#' - For `fetch_tbl`: a [`tibble::tibble`] -#' @keywords internal -fetch_tbl <- function(epidata_call, fetch_args = fetch_args_list()) { - stopifnot(inherits(epidata_call, "epidata_call")) - stopifnot(inherits(fetch_args, "fetch_args")) + # Check if the data is cachable + is_cachable <- check_is_cachable(epidata_call, fetch_args) + if (is_cachable) { + check_for_cache_warnings(epidata_call, fetch_args) - if (epidata_call$only_supports_classic) { - cli::cli_abort( - c( - "This endpoint only supports the classic message format, due to non-standard behavior. - Use fetch_classic instead." - ), - epidata_call = epidata_call, - class = "only_supports_classic_format" - ) + # Check if the data is in the cache + target <- request_url(epidata_call) + hashed <- md5(target) + cached <- cache_environ$epidatr_cache$get(hashed) + if (!is.key_missing(cached)) { + return(cached[[1]]) # extract `fetched` from `fetch()`, no metadata + } } - response_content <- fetch_classic(epidata_call, fetch_args = fetch_args) - if (fetch_args$return_empty && length(response_content) == 0) { - return(tibble()) + # Need to actually get the data, since its either not in the cache or we're not caching + runtime <- system.time(if (epidata_call$only_supports_classic) { + fetch_args[["disable_data_frame_parsing"]] <- TRUE + fetched <- fetch_classic(epidata_call, fetch_args) + } else { + response_content <- fetch_classic(epidata_call, fetch_args = fetch_args) + if (fetch_args$return_empty && length(response_content) == 0) { + fetched <- tibble() + } else { + fetched <- parse_data_frame(epidata_call, response_content, fetch_args$disable_date_parsing) %>% as_tibble() + } + }) + + # Add it to the cache if appropriate + if (is_cachable || (fetch_args$refresh_cache && is_cache_enabled())) { + cache_environ$epidatr_cache$set(hashed, list(fetched, Sys.time(), runtime)) } - return(parse_data_frame(epidata_call, response_content, fetch_args$disable_date_parsing) %>% as_tibble()) + + return(fetched) } #' Fetches the data, raises on epidata errors, and returns the results as a @@ -303,6 +312,7 @@ fetch_classic <- function(epidata_call, fetch_args = fetch_args_list()) { ) } } + if (response_content$message != "success") { cli::cli_warn( c( @@ -311,6 +321,7 @@ fetch_classic <- function(epidata_call, fetch_args = fetch_args_list()) { class = "epidata_warning" ) } + return(response_content$epidata) } diff --git a/R/utils.R b/R/utils.R index 15356734..c74e9492 100644 --- a/R/utils.R +++ b/R/utils.R @@ -30,26 +30,6 @@ check_is_recent <- function(dates, max_age) { (!is.null(dates) && any(dates >= threshold)) } -#' helper that checks whether a call is actually cachable -#' -#' @keywords internal -check_is_cachable <- function(epidata_call, fetch_args) { - as_of_cachable <- (!is.null(epidata_call$params$as_of) && !identical(epidata_call$params$as_of, "*")) - issues_cachable <- (!is.null(epidata_call$params$issues) && all(!identical(epidata_call$params$issues, "*"))) - is_cachable <- ( - !is.null(cache_environ$epidatr_cache) && - (as_of_cachable || issues_cachable) && - !(fetch_args$dry_run) && - is.null(fetch_args$base_url) && - !fetch_args$debug && - fetch_args$format_type == "json" && - is.null(fetch_args$fields) && - !fetch_args$disable_date_parsing && - !fetch_args$disable_data_frame_parsing - ) - return(is_cachable) -} - #' helper to convert a date wildcard ("*") to an appropriate epirange #' #' @keywords internal diff --git a/man/cache_epidata_call.Rd b/man/check_for_cache_warnings.Rd similarity index 55% rename from man/cache_epidata_call.Rd rename to man/check_for_cache_warnings.Rd index 5d3c3f8b..978dbe42 100644 --- a/man/cache_epidata_call.Rd +++ b/man/check_for_cache_warnings.Rd @@ -1,10 +1,10 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/cache.R -\name{cache_epidata_call} -\alias{cache_epidata_call} -\title{Dispatch caching} +\name{check_for_cache_warnings} +\alias{check_for_cache_warnings} +\title{Check for warnings for the cache} \usage{ -cache_epidata_call(epidata_call, fetch_args = fetch_args_list()) +check_for_cache_warnings(epidata_call, fetch_args) } \arguments{ \item{epidata_call}{the \code{epidata_call} object} @@ -12,7 +12,6 @@ cache_epidata_call(epidata_call, fetch_args = fetch_args_list()) \item{fetch_args}{the args list for fetch as generated by \code{\link[=fetch_args_list]{fetch_args_list()}}} } \description{ -The guts of caching, its interposed between fetch and the specific fetch -methods. Internal method only. +Adds warnings when arguments are potentially too recent to use with the cache. } \keyword{internal} diff --git a/man/check_is_cachable.Rd b/man/check_is_cachable.Rd index 5238f89c..7b812594 100644 --- a/man/check_is_cachable.Rd +++ b/man/check_is_cachable.Rd @@ -1,12 +1,23 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/utils.R +% Please edit documentation in R/cache.R \name{check_is_cachable} \alias{check_is_cachable} -\title{helper that checks whether a call is actually cachable} +\title{Helper that checks whether a call is actually cachable} \usage{ check_is_cachable(epidata_call, fetch_args) } \description{ -helper that checks whether a call is actually cachable +The cacheable endpoints are those with \code{as_of} or \code{issues} parameters: +\itemize{ +\item pub_covidcast +\item pub_covid_hosp_state_timeseries +\item pub_ecdc_ili +\item pub_flusurv +\item pub_fluview_clinical +\item pub_fluview +\item pub_kcdc_ili +\item pub_nidss_flu +\item pub_paho_dengue +} } \keyword{internal} diff --git a/man/clear_cache.Rd b/man/clear_cache.Rd index f5d232b9..c34b0715 100644 --- a/man/clear_cache.Rd +++ b/man/clear_cache.Rd @@ -38,9 +38,9 @@ environment } \description{ Deletes the current cache and resets a new cache. Deletes local data! If you -are using a session unique cache, you will have to pass the arguments you -used for \code{set_cache} earlier, otherwise the system-wide \code{.Renviron}-based -defaults will be used. +are using a session unique cache, the previous settings will be reused. If +you pass in new \code{set_cache} arguments, they will take precedence over the +previous settings. } \seealso{ \code{\link{set_cache}} to start a new cache (and general caching info), diff --git a/man/covidcast_epidata.Rd b/man/covidcast_epidata.Rd index fbf3f1cc..d582a012 100644 --- a/man/covidcast_epidata.Rd +++ b/man/covidcast_epidata.Rd @@ -27,7 +27,7 @@ an object containing fields for every signal: \if{html}{\out{
}}\preformatted{epidata <- covidcast_epidata() epidata$signals -#> # A tibble: 468 x 3 +#> # A tibble: 486 x 3 #> source signal short_description #> #> 1 chng smoothed_outpatient_cli Estimated percentage of outpatie~ @@ -40,7 +40,7 @@ epidata$signals #> 8 chng 7dav_outpatient_covid Ratio of outpatient doctor visit~ #> 9 covid-act-now pcr_specimen_positivity_rate Proportion of PCR specimens test~ #> 10 covid-act-now pcr_specimen_total_tests Total number of PCR specimens te~ -#> # i 458 more rows +#> # i 476 more rows }\if{html}{\out{
}} If you use an editor that supports tab completion, such as RStudio, type diff --git a/man/fetch_args_list.Rd b/man/fetch_args_list.Rd index ca6f7dcf..1701288c 100644 --- a/man/fetch_args_list.Rd +++ b/man/fetch_args_list.Rd @@ -15,7 +15,8 @@ fetch_args_list( base_url = NULL, dry_run = FALSE, debug = FALSE, - format_type = c("json", "classic", "csv") + format_type = c("json", "classic", "csv"), + refresh_cache = FALSE ) } \arguments{ @@ -48,6 +49,9 @@ base URL \code{"https://api.delphi.cmu.edu/epidata/"}} \item{format_type}{the format to request from the API, one of classic, json, csv; this is only used by \code{fetch_debug}, and by default is \code{"json"}} + +\item{refresh_cache}{if \code{TRUE}, ignore the cache, fetch the data from the +API, and update the cache, if it is enabled} } \value{ A \code{fetch_args} object containing all the specified options diff --git a/man/fetch_tbl.Rd b/man/fetch_tbl.Rd deleted file mode 100644 index bb74e65e..00000000 --- a/man/fetch_tbl.Rd +++ /dev/null @@ -1,22 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/epidatacall.R -\name{fetch_tbl} -\alias{fetch_tbl} -\title{Fetches the data and returns a tibble} -\usage{ -fetch_tbl(epidata_call, fetch_args = fetch_args_list()) -} -\arguments{ -\item{epidata_call}{an instance of \code{epidata_call}} - -\item{fetch_args}{a \code{fetch_args} object} -} -\value{ -\itemize{ -\item For \code{fetch_tbl}: a \code{\link[tibble:tibble]{tibble::tibble}} -} -} -\description{ -Fetches the data and returns a tibble -} -\keyword{internal} diff --git a/man/is_cache_enabled.Rd b/man/is_cache_enabled.Rd new file mode 100644 index 00000000..3df250d7 --- /dev/null +++ b/man/is_cache_enabled.Rd @@ -0,0 +1,12 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/cache.R +\name{is_cache_enabled} +\alias{is_cache_enabled} +\title{Check if the cache is enabled} +\usage{ +is_cache_enabled() +} +\description{ +Check if the cache is enabled +} +\keyword{internal} diff --git a/tests/testthat/test-cache.R b/tests/testthat/test-cache.R index 8d75644b..3cbfccdd 100644 --- a/tests/testthat/test-cache.R +++ b/tests/testthat/test-cache.R @@ -1,7 +1,3 @@ -test_that("basic cache setup", { - expect_true(is.null(cache_environ$epidatr_cache)) -}) - new_temp_dir <- tempdir() test_set_cache <- function(cache_dir = new_temp_dir, days = 1, @@ -17,8 +13,17 @@ test_set_cache <- function(cache_dir = new_temp_dir, ) } +test_that("basic cache setup", { + # Should be off at the start + expect_true(!is_cache_enabled()) +}) + test_that("cache set as expected", { + # Setup a new cache expect_message(test_set_cache()) + # Delete cache files after the test + withr::defer(clear_cache(disable = TRUE)) + if (grepl("/", as.character(new_temp_dir))) { # this is what check produces expect_equal(cache_info()$dir, normalizePath(new_temp_dir)) @@ -33,12 +38,15 @@ test_that("cache set as expected", { expect_equal(cache_info()$logfile, file.path(new_temp_dir, "logfile.txt")) expect_equal(cache_info()$evict, "lru") expect_equal(cache_info()$max_n, Inf) - disable_cache() }) # use an existing example to save, then load and compare the values test_that("cache saves & loads", { + # Setup a new cache expect_message(test_set_cache()) + # Delete cache files after the test + withr::defer(clear_cache(disable = TRUE)) + epidata_call <- pub_covidcast( source = "jhu-csse", signals = "confirmed_7dav_incidence_prop", @@ -49,23 +57,25 @@ test_that("cache saves & loads", { as_of = "2022-01-01", fetch_args = fetch_args_list(dry_run = TRUE) ) + httr_content_called_count <- 0 local_mocked_bindings( request_impl = function(...) NULL, .package = "epidatr" ) local_mocked_bindings( # see generate_test_data.R - content = function(...) readRDS(testthat::test_path("data/test-classic.rds")), + content = function(...) { + httr_content_called_count <<- httr_content_called_count + 1 + readRDS(testthat::test_path("data/test-classic.rds")) + }, .package = "httr" ) - # testing the cache_info first_call <- epidata_call %>% fetch() - # compare cached call w/non cached (and make sure it's fetching from the cache) - rlang::reset_warning_verbosity("using the cache") - expect_warning(cache_call <- epidata_call %>% fetch(), class = "cache_access") - rlang::reset_warning_verbosity("using the cache") + cache_call <- epidata_call %>% fetch() + expect_equal(httr_content_called_count, 1) expect_equal(first_call, cache_call) + # and compare directly with the file saved # the request url hashed here is "https://api.delphi.cmu.edu/epidata/covidcast/?data_source=jhu-csse&signals= # confirmed_7dav_incidence_prop&geo_type=state&time_type=day&geo_values=ca%2Cfl&time_values=20200601-20200801 @@ -73,6 +83,19 @@ test_that("cache saves & loads", { request_hash <- "01479468989102176d7cb70374f18f1f.rds" direct_from_cache <- readRDS(file.path(new_temp_dir, request_hash)) expect_equal(first_call, direct_from_cache[[1]]) + + # Test the empty return branch + expect_message(clear_cache()) + local_mocked_bindings( + # see generate_test_data.R + content = function(...) { + httr_content_called_count <<- httr_content_called_count + 1 + '{"epidata":[],"result":-2,"message":"no results"}' + }, + .package = "httr" + ) + expect_warning(empty_call <- epidata_call %>% fetch()) + expect_equal(empty_call, tibble()) }) test_that("check_is_recent", { @@ -111,6 +134,11 @@ test_that("check_is_recent", { }) test_that("check_is_cachable", { + # Setup a new cache + expect_message(test_set_cache()) + # Delete cache files after the test + withr::defer(clear_cache(disable = TRUE)) + check_fun <- function(..., fetch_args = fetch_args_list(), expected_result) { epidata_call <- pub_covidcast( source = "jhu-csse", @@ -128,13 +156,14 @@ test_that("check_is_cachable", { expect_false(check_is_cachable(epidata_call, fetch_args)) } } - expect_message(test_set_cache()) check_fun(expected_result = FALSE) # doesn't specify issues or as_of check_fun(as_of = "2020-01-01", expected_result = TRUE) # valid as_of check_fun(issues = "2020-01-01", expected_result = TRUE) # valid issues check_fun(issues = epirange("2020-01-01", "2020-03-01"), expected_result = TRUE) # valid issues check_fun(as_of = "*", expected_result = FALSE) # invalid as_of check_fun(issues = "*", expected_result = FALSE) # invalid issues + # refresh_cache works + check_fun(as_of = "2020-01-01", fetch_args = fetch_args_list(refresh_cache = TRUE), expected_result = FALSE) # any odd fetch args mean don't use the cache check_fun( @@ -184,12 +213,3 @@ test_that("check_is_cachable", { expect_message(test_set_cache()) check_fun(as_of = "2020-01-01", expected_result = TRUE) }) - -expect_message(test_set_cache()) -cache_environ$epidatr_cache$prune() -clear_cache(disable = TRUE) -rm(new_temp_dir) - -test_that("cache teardown", { - expect_true(is.null(cache_environ$epidatr_cache)) -}) diff --git a/tests/testthat/test-epidatacall.R b/tests/testthat/test-epidatacall.R index 028ba1f4..69f885b4 100644 --- a/tests/testthat/test-epidatacall.R +++ b/tests/testthat/test-epidatacall.R @@ -42,7 +42,8 @@ test_that("fetch_args", { base_url = NULL, dry_run = FALSE, debug = FALSE, - format_type = "json" + format_type = "json", + refresh_cache = FALSE ), class = "fetch_args" ) @@ -57,7 +58,8 @@ test_that("fetch_args", { base_url = "https://example.com", dry_run = TRUE, debug = TRUE, - format_type = "classic" + format_type = "classic", + refresh_cache = TRUE ), structure( list( @@ -69,14 +71,16 @@ test_that("fetch_args", { base_url = "https://example.com", dry_run = TRUE, debug = TRUE, - format_type = "classic" + format_type = "classic", + refresh_cache = TRUE ), class = "fetch_args" ) ) }) -test_that("fetch and fetch_tbl", { +test_that("fetch non-classic works", { + # only_supports_classic is FALSE epidata_call <- pub_covidcast( source = "jhu-csse", signals = "confirmed_7dav_incidence_prop", @@ -95,22 +99,20 @@ test_that("fetch and fetch_tbl", { content = function(...) readRDS(testthat::test_path("data/test-classic.rds")), .package = "httr" ) - - tbl_out <- epidata_call %>% fetch_tbl() - out <- epidata_call %>% fetch() - expect_identical(out, tbl_out) - local_mocked_bindings( # see generate_test_data.R content = function(...) readRDS(testthat::test_path("data/test-narrower-fields.rds")), .package = "httr" ) + # testing that the fields fill as expected + out <- epidata_call %>% fetch() res <- epidata_call %>% fetch(fetch_args_list(fields = c("time_value", "value"))) - expect_equal(res, tbl_out[c("time_value", "value")]) + expect_equal(res, out[c("time_value", "value")]) }) -test_that("fetch_tbl warns on non-success", { +test_that("fetch non-classic passes along api warnings", { + # only_supports_classic is FALSE epidata_call <- pub_covidcast( source = "jhu-csse", signals = "confirmed_7dav_incidence_prop", @@ -142,14 +144,14 @@ test_that("fetch_tbl warns on non-success", { .package = "jsonlite" ) - expect_warning(epidata_call %>% fetch_tbl(), + expect_warning(epidata_call %>% fetch(), regexp = paste0("epidata warning: `", artificial_warning, "`"), fixed = TRUE ) }) -test_that("classic only fetch", { - # delphi is an example endpoint that only suports the classic call +test_that("fetch classic works", { + # only_supports_classic is TRUE epidata_call <- pub_delphi( system = "ec", epiweek = 201501, @@ -160,13 +162,10 @@ test_that("classic only fetch", { content = function(...) readRDS(testthat::test_path("data/test-classic-only.rds")), .package = "httr" ) - # make sure that fetch actually uses the classic method on endpoints that only support the classic - fetch_out <- epidata_call %>% fetch() - fetch_classic_out <- epidata_call %>% fetch_classic() - expect_identical(fetch_out, fetch_classic_out) - # making sure that fetch_tbl and throws the expected error on classic only - expect_error(epidata_call %>% fetch_tbl(), class = "only_supports_classic_format") + # make sure the return from this is a list + fetch_out <- epidata_call %>% fetch() + expect_true(inherits(fetch_out, "list")) }) test_that("create_epidata_call basic behavior", { From 7d421550ec63c92d4c9253eaeae0c1c6dc87686b Mon Sep 17 00:00:00 2001 From: dshemetov Date: Tue, 18 Mar 2025 20:24:49 +0000 Subject: [PATCH 2/2] docs: document (GHA) --- man/covidcast_epidata.Rd | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/man/covidcast_epidata.Rd b/man/covidcast_epidata.Rd index d582a012..fbf3f1cc 100644 --- a/man/covidcast_epidata.Rd +++ b/man/covidcast_epidata.Rd @@ -27,7 +27,7 @@ an object containing fields for every signal: \if{html}{\out{
}}\preformatted{epidata <- covidcast_epidata() epidata$signals -#> # A tibble: 486 x 3 +#> # A tibble: 468 x 3 #> source signal short_description #> #> 1 chng smoothed_outpatient_cli Estimated percentage of outpatie~ @@ -40,7 +40,7 @@ epidata$signals #> 8 chng 7dav_outpatient_covid Ratio of outpatient doctor visit~ #> 9 covid-act-now pcr_specimen_positivity_rate Proportion of PCR specimens test~ #> 10 covid-act-now pcr_specimen_total_tests Total number of PCR specimens te~ -#> # i 476 more rows +#> # i 458 more rows }\if{html}{\out{
}} If you use an editor that supports tab completion, such as RStudio, type