From f63d1d3d22121e628f7441edabe438e3f932b96c Mon Sep 17 00:00:00 2001 From: Neal Richardson Date: Mon, 10 Apr 2023 10:39:09 -0400 Subject: [PATCH 1/4] Use options(httpcache.env) to hold cache env --- R/cache.R | 14 +++++++------- R/load-cache.R | 20 ++++++++++---------- tests/testthat/test-zzz-helper.R | 3 --- 3 files changed, 17 insertions(+), 20 deletions(-) delete mode 100644 tests/testthat/test-zzz-helper.R diff --git a/R/cache.R b/R/cache.R index 88845ed..e066ba9 100644 --- a/R/cache.R +++ b/R/cache.R @@ -23,7 +23,7 @@ cacheOff <- function() { #' @export clearCache <- function() { logMessage("CACHE CLEAR") - rm(list = cacheKeys(), envir = cache) + rm(list = cacheKeys(), envir = cache()) } #' HTTP Cache API @@ -37,7 +37,7 @@ clearCache <- function() { #' @name cache-api #' @export hitCache <- function(key) { - exists(key, envir = cache) + exists(key, envir = cache()) } #' @rdname cache-api @@ -45,7 +45,7 @@ hitCache <- function(key) { getCache <- function(key) { if (hitCache(key)) { logMessage("CACHE HIT", key) - return(get(key, envir = cache)) + return(get(key, envir = cache())) } else { return(NULL) } @@ -55,10 +55,10 @@ getCache <- function(key) { #' @export setCache <- function(key, value) { logMessage("CACHE SET", key) - assign(key, value, envir = cache) + assign(key, value, envir = cache()) } -cacheKeys <- function() ls(all.names = TRUE, envir = cache) +cacheKeys <- function() ls(all.names = TRUE, envir = cache()) #' Construct a unique cache key for a request #' @@ -125,14 +125,14 @@ dropCache <- function(x) { #' @export dropOnly <- function(x) { logMessage("CACHE DROP", x) - suppressWarnings(rm(list = x, envir = cache)) + suppressWarnings(rm(list = x, envir = cache())) } #' @rdname dropCache #' @export dropPattern <- function(x) { logMessage("CACHE DROP", x) - rm(list = ls(envir = cache, pattern = x), envir = cache) + rm(list = ls(envir = cache(), pattern = x), envir = cache()) } regexEscape <- function(x) { diff --git a/R/load-cache.R b/R/load-cache.R index 6180899..850ccbf 100644 --- a/R/load-cache.R +++ b/R/load-cache.R @@ -1,9 +1,12 @@ -# Create the cache env -cache <- NULL -initCache <- function() { - cache <<- new.env(hash = TRUE) +cache <- function() { + cache_env <- getOption("httpcache.env") + if (!inherits(cache_env, "environment")) { + # No/invalid cache object; create one now + cache_env <- new.env(hash = TRUE) + options(httpcache.env = cache_env) + } + cache_env } -initCache() #' Save and load cache state #' @@ -13,7 +16,7 @@ initCache() #' @return Nothing; called for side effects. #' @export saveCache <- function(file) { - saveRDS(cache, file = file) + saveRDS(cache(), file = file) } #' @rdname saveCache @@ -23,9 +26,6 @@ loadCache <- function(file) { if (!is.environment(env)) { halt("'loadCache' requires an .rds file containing an environment") } - # Copy the values over - for (key in ls(all.names = TRUE, envir = env)) { - setCache(key, get(key, env)) - } + options(httpcache.env = env) invisible(NULL) } diff --git a/tests/testthat/test-zzz-helper.R b/tests/testthat/test-zzz-helper.R deleted file mode 100644 index c2b78bc..0000000 --- a/tests/testthat/test-zzz-helper.R +++ /dev/null @@ -1,3 +0,0 @@ -# Putting this here just so covr runs it. It obviously does, but not in the -# test suite -try(initCache(), silent = TRUE) From 4d030fcddc4a3cb0dbd30d80a2aea4c63e68dab3 Mon Sep 17 00:00:00 2001 From: Neal Richardson Date: Mon, 10 Apr 2023 10:45:29 -0400 Subject: [PATCH 2/4] loadCache as environment --- R/load-cache.R | 12 ++++++++---- tests/testthat/test-load-cache.R | 13 +++++++++++++ 2 files changed, 21 insertions(+), 4 deletions(-) diff --git a/R/load-cache.R b/R/load-cache.R index 850ccbf..0e45d8b 100644 --- a/R/load-cache.R +++ b/R/load-cache.R @@ -12,6 +12,8 @@ cache <- function() { #' #' Warm your query cache from a previous session by saving out the cache and #' loading it back in. +#' @param x for `loadCache()`, either an `environment` or a string path to one +#' saved in an `.rds` file #' @param file character file path to write the cache data to, in `.rds` format #' @return Nothing; called for side effects. #' @export @@ -21,11 +23,13 @@ saveCache <- function(file) { #' @rdname saveCache #' @export -loadCache <- function(file) { - env <- readRDS(file) - if (!is.environment(env)) { +loadCache <- function(x) { + if (is.character(x)) { + x <- readRDS(x) + } + if (!is.environment(x)) { halt("'loadCache' requires an .rds file containing an environment") } - options(httpcache.env = env) + options(httpcache.env = x) invisible(NULL) } diff --git a/tests/testthat/test-load-cache.R b/tests/testthat/test-load-cache.R index 5c23c0d..cf1d669 100644 --- a/tests/testthat/test-load-cache.R +++ b/tests/testthat/test-load-cache.R @@ -32,6 +32,19 @@ public({ test_that("Can load cache and read from it as before", { loadCache(f) + on.exit(clearCache()) + # Now read from cache + expect_no_request( + expect_identical(GET("https://app.crunch.io/api/datasets"), a) + ) + }) + + test_that("Can load cache as environment", { + old_cache <- readRDS(f) + expect_is(old_cache, "environment") + + loadCache(old_cache) + on.exit(clearCache()) # Now read from cache expect_no_request( expect_identical(GET("https://app.crunch.io/api/datasets"), a) From bcaff0c03d84aa390bf1935df48820ee27b432da Mon Sep 17 00:00:00 2001 From: Neal Richardson Date: Mon, 10 Apr 2023 10:56:23 -0400 Subject: [PATCH 3/4] Add withCache() --- NAMESPACE | 1 + R/load-cache.R | 20 ++++++++++++++++---- man/saveCache.Rd | 16 +++++++++++++--- tests/testthat/test-load-cache.R | 20 ++++++++++++++++++++ 4 files changed, 50 insertions(+), 7 deletions(-) diff --git a/NAMESPACE b/NAMESPACE index eda5f50..01400b5 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -25,6 +25,7 @@ export(saveCache) export(setCache) export(startLog) export(uncached) +export(withCache) importFrom(digest,digest) importFrom(httr,DELETE) importFrom(httr,GET) diff --git a/R/load-cache.R b/R/load-cache.R index 0e45d8b..4917432 100644 --- a/R/load-cache.R +++ b/R/load-cache.R @@ -11,11 +11,14 @@ cache <- function() { #' Save and load cache state #' #' Warm your query cache from a previous session by saving out the cache and -#' loading it back in. -#' @param x for `loadCache()`, either an `environment` or a string path to one -#' saved in an `.rds` file +#' loading it back in. `withCache()` wraps `loadCache()` and restores the +#' previous cache after evaluating the code +#' @param x for `loadCache()` and `withCache()`, either an `environment` or a +#' string path to one saved in an `.rds` file #' @param file character file path to write the cache data to, in `.rds` format -#' @return Nothing; called for side effects. +#' @param ... code to evaluate using the cache in `x` +#' @return `withCache()` returns the value of `...`. `saveCache()` and +#' `loadCache()` return nothing. #' @export saveCache <- function(file) { saveRDS(cache(), file = file) @@ -33,3 +36,12 @@ loadCache <- function(x) { options(httpcache.env = x) invisible(NULL) } + +#' @rdname saveCache +#' @export +withCache <- function(x, ...) { + old <- getOption("httpcache.env") + on.exit(options(httpcache.env = old)) + loadCache(x) + eval.parent(...) +} \ No newline at end of file diff --git a/man/saveCache.Rd b/man/saveCache.Rd index a6f7ea1..a342acb 100644 --- a/man/saveCache.Rd +++ b/man/saveCache.Rd @@ -3,19 +3,29 @@ \name{saveCache} \alias{saveCache} \alias{loadCache} +\alias{withCache} \title{Save and load cache state} \usage{ saveCache(file) -loadCache(file) +loadCache(x) + +withCache(x, ...) } \arguments{ \item{file}{character file path to write the cache data to, in \code{.rds} format} + +\item{x}{for \code{loadCache()} and \code{withCache()}, either an \code{environment} or a +string path to one saved in an \code{.rds} file} + +\item{...}{code to evaluate using the cache in \code{x}} } \value{ -Nothing; called for side effects. +\code{withCache()} returns the value of \code{...}. \code{saveCache()} and +\code{loadCache()} return nothing. } \description{ Warm your query cache from a previous session by saving out the cache and -loading it back in. +loading it back in. \code{withCache()} wraps \code{loadCache()} and restores the +previous cache after evaluating the code } diff --git a/tests/testthat/test-load-cache.R b/tests/testthat/test-load-cache.R index cf1d669..fb7fe59 100644 --- a/tests/testthat/test-load-cache.R +++ b/tests/testthat/test-load-cache.R @@ -50,6 +50,26 @@ public({ expect_identical(GET("https://app.crunch.io/api/datasets"), a) ) }) +test_that("withCache()", { + expect_length(cacheKeys(), 0) + expect_GET( + GET("https://app.crunch.io/api/datasets"), + "https://app.crunch.io/api/datasets" + ) + + withCache(f, { + expect_length(cacheKeys(), 2) + expect_no_request( + expect_identical(GET("https://app.crunch.io/api/datasets"), a) + ) + }) + + expect_length(cacheKeys(), 0) + expect_GET( + GET("https://app.crunch.io/api/datasets"), + "https://app.crunch.io/api/datasets" + ) +}) }) test_that("loadCache error handling", { From 47be3e883731d8833fa6e47f947d26abbb2ca536 Mon Sep 17 00:00:00 2001 From: Neal Richardson Date: Mon, 10 Apr 2023 10:57:57 -0400 Subject: [PATCH 4/4] NEWS and version bump --- DESCRIPTION | 2 +- NEWS.md | 5 +++++ 2 files changed, 6 insertions(+), 1 deletion(-) diff --git a/DESCRIPTION b/DESCRIPTION index 54f3abe..c72f6da 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -9,7 +9,7 @@ Description: In order to improve performance for HTTP API clients, 'httpcache' APIs; the package also enables custom cache-management strategies. Finally, 'httpcache' includes a basic logging framework to facilitate the measurement of HTTP request time and cache performance. -Version: 1.2.0 +Version: 1.2.0.9000 Authors@R: c(person("Neal", "Richardson", role = c("aut", "cre"), email = "neal.p.richardson@gmail.com")) URL: https://enpiar.com/r/httpcache/, https://github.com/nealrichardson/httpcache/ diff --git a/NEWS.md b/NEWS.md index bcf8b36..ca92fcb 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,3 +1,8 @@ +# httpcache 1.2.0.9000 + +* `withCache(x, ...)` lets you evaluate code blocks with different cache environments +* `loadCache()` accepts an `environment` from the current R session to use as a cache, in addition to a string file path of a saved environment. + # httpcache 1.2.0 * Update tests to use latest features and function naming from `httptest`