cache settings

NAMESPACE

@@ -63,6 +63,7 @@ export(make_standalone)
 export(map_nhdplus)
 export(navigate_network)
 export(navigate_nldi)
+export(nhdplusTools_cache_settings)
 export(nhdplusTools_data_dir)
 export(nhdplus_path)
 export(plot_nhdplus)

R/A_nhdplusTools.R

@@ -353,25 +353,73 @@ nhdplus_path <- function(path = NULL, warn = FALSE) {
   }
 }
 
+#' @title nhdplusTools cache settings
+#' @description
+#' Provides an interface to adjust nhdplusTools `memoise` cache.
+#'
+#' Mode and timeout can also be set using environment variables.
+#' `NHDPLUSTOOLS_MEMOISE_CACHE` and `NHDPLUSTOOLS_MEMOISE_TIMEOUT` are
+#' used unless overriden with this function.
+#'
+#' @param mode character 'memory' or 'filesystem'
+#' @param timeout numeric number of seconds until caches invalidate
+#' @return list containing settings at time of calling. If inputs are
+#' NULL, current settings. If settings are altered, previous setting values.
+#' @export
+
+nhdplusTools_cache_settings <- function(mode = NULL, timeout = NULL) {
+  current_mode <- get("nhdpt_mem_cache", envir = nhdplusTools_env)
+  current_timeout <- get("nhdpt_cache_timeout", envir = nhdplusTools_env)
+
+  if(!is.null(mode) && mode %in% c("memory", "filesystem")) {
+    assign("nhdpt_mem_cache", mode, envir = nhdplusTools_env)
+  }
+
+  if(!is.null(timeout) && is.numeric(timeout)) {
+    assign("nhdpt_cache_timeout", timeout, envir = nhdplusTools_env)
+  }
+
+  return(invisible(list(mode = current_mode, timeout = current_timeout)))
+}
+
 nhdplusTools_memoise_cache <- function() {
-  memo_cache <- Sys.getenv("NHDPLUSTOOLS_MEMOISE_CACHE")
-  if(memo_cache == "memory") {
-    memoise::cache_memory()
+  sys_memo_cache <- Sys.getenv("NHDPLUSTOOLS_MEMOISE_CACHE")
+  ses_memo_cache <- try(get("nhdpt_mem_cache", envir = nhdplusTools_env), silent = TRUE)
+
+  # if it hasn't been set up yet, try to use the system env
+  if(!inherits(ses_memo_cache, "try-error")) {
+    return(ses_memo_cache)
   } else {
-    memoise::cache_filesystem(nhdplusTools_data_dir())
+    if(sys_memo_cache == "memory") {
+      memoise::cache_memory()
+    } else {
+      memoise::cache_filesystem(nhdplusTools_data_dir())
+    }
+
   }
+
 }
 
 nhdplusTools_memoise_timeout <- function() {
-  timeout_env <- Sys.getenv("NHDPLUSTOOLS_MEMOISE_TIMEOUT")
-  if(timeout_env != "") {
-    as.numeric(timeout_env)
+  sys_timeout <- Sys.getenv("NHDPLUSTOOLS_MEMOISE_TIMEOUT")
+  ses_timeout <- try(get("nhdpt_cache_timeout", envir = nhdplusTools_env), silent = TRUE)
+
+  # if it hasn't been set up yet, try to use the system env
+  if(!inherits(ses_timeout, "try-error")) {
+    return(ses_timeout)
   } else {
-    # default to one day
-    oneday_seconds <- 60 * 60 * 24
+    if(sys_timeout != "") {
+      as.numeric(sys_timeout)
+    } else {
+      # default to one day
+      oneday_seconds <- 60 * 60 * 24
+    }
   }
 }
 
+assign("nhdpt_mem_cache", nhdplusTools_memoise_cache(), envir = nhdplusTools_env)
+assign("nhdpt_cache_timeout", nhdplusTools_memoise_timeout(), envir = nhdplusTools_env)
+
 #' @title Align NHD Dataset Names
 #' @description this function takes any NHDPlus dataset and aligns the attribute names with those used in nhdplusTools.
 #' @param x a \code{sf} object of nhdplus flowlines

tests/testthat/helper.R

@@ -3,6 +3,8 @@ options("rgdal_show_exportToProj4_warnings"="none")
 library("sf")
 library("dplyr")
 
+nhdplusTools_cache_settings(mode = "memory", timeout = 1)
+
 sf::sf_use_s2(TRUE)
 
 unlink(file.path(tempdir(check = TRUE), "*"), recursive = TRUE)

tests/testthat/test_arcrest.R

@@ -64,7 +64,7 @@ test_that("basic 3dhp service requests", {
   expect_message(expect_s3_class(nhdplusTools:::query_usgs_arcrest(AOI),
                                  "data.frame"))
 
-  expect_warning(nhdplusTools:::query_usgs_arcrest(AOI, type = "hydrolocation"))
+  expect_warning(expect_warning(nhdplusTools:::query_usgs_arcrest(AOI, type = "hydrolocation")))
 
   test_data <- nhdplusTools:::query_usgs_arcrest(AOI, type = "reach code, external connection")