Add withCache() and allow loadCache() to use other environments

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 = "[email protected]"))
 URL: https://enpiar.com/r/httpcache/, https://github.com/nealrichardson/httpcache/

NAMESPACE

@@ -25,6 +25,7 @@ export(saveCache)
 export(setCache)
 export(startLog)
 export(uncached)
+export(withCache)
 importFrom(digest,digest)
 importFrom(httr,DELETE)
 importFrom(httr,GET)

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`

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,15 +37,15 @@ clearCache <- function() {
 #' @name cache-api
 #' @export
 hitCache <- function(key) {
-  exists(key, envir = cache)
+  exists(key, envir = cache())
 }
 
 #' @rdname cache-api
 #' @export
 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) {

R/load-cache.R

@@ -1,31 +1,47 @@
-# 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
 #'
 #' Warm your query cache from a previous session by saving out the cache and
-#' loading it back in.
+#' 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)
+  saveRDS(cache(), file = file)
 }
 
 #' @rdname saveCache
 #' @export
-loadCache <- function(file) {
-  env <- readRDS(file)
-  if (!is.environment(env)) {
-    halt("'loadCache' requires an .rds file containing an environment")
+loadCache <- function(x) {
+  if (is.character(x)) {
+    x <- readRDS(x)
   }
-  # Copy the values over
-  for (key in ls(all.names = TRUE, envir = env)) {
-    setCache(key, get(key, env))
+  if (!is.environment(x)) {
+    halt("'loadCache' requires an .rds file containing an environment")
   }
+  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(...)
+}

tests/testthat/test-load-cache.R

@@ -32,11 +32,44 @@ 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)
+      )
+    })
+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", {