From 41ed519bf80da73d7c5ff8f3c7dd49131c3005b7 Mon Sep 17 00:00:00 2001
From: David Blodgett <dblodgett@usgs.gov>
Date: Sat, 23 Mar 2024 14:18:29 -0500
Subject: [PATCH] incorporate basic memoise functionality

---
 DESCRIPTION         |  2 +-
 R/A_nhdplusTools.R  | 18 ++++++++++++++++++
 R/arcrest_tools.R   |  4 ++--
 R/geoserver_tools.R |  8 ++++----
 R/get_nldi.R        |  4 ++--
 5 files changed, 27 insertions(+), 9 deletions(-)

diff --git a/DESCRIPTION b/DESCRIPTION
index 68f8f629..b8357633 100644
--- a/DESCRIPTION
+++ b/DESCRIPTION
@@ -28,7 +28,7 @@ URL: https://doi-usgs.github.io/nhdplusTools/ https://github.com/doi-usgs/nhdplu
 BugReports: https://github.com/doi-usgs/nhdplusTools/issues/
 Depends:
     R (>= 4.0)
-Imports: hydroloom, dataRetrieval, dplyr, sf, units, magrittr, jsonlite, httr, xml2, R.utils, utils, tidyr, methods, maptiles, mapsf, fst, arrow, tools, zip, pbapply
+Imports: hydroloom, dataRetrieval, dplyr, sf, units, magrittr, jsonlite, httr, xml2, R.utils, utils, tidyr, methods, maptiles, mapsf, fst, arrow, tools, zip, pbapply, memoise
 Suggests: testthat, knitr, rmarkdown, ggmap, ggplot2, lwgeom, gifski, leaflet, httptest, future, future.apply
 License: CC0
 Encoding: UTF-8
diff --git a/R/A_nhdplusTools.R b/R/A_nhdplusTools.R
index 8957919e..e1dc247f 100644
--- a/R/A_nhdplusTools.R
+++ b/R/A_nhdplusTools.R
@@ -353,6 +353,24 @@ nhdplus_path <- function(path = NULL, warn = FALSE) {
   }
 }
 
+nhdplusTools_memoise_cache <- function() {
+  memo_cache <- Sys.getenv("NHDPLUSTOOLS_MEMOISE_CACHE")
+  if(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)
+  } else {
+    # default to one day
+    oneday_seconds <- 60 * 60 * 24
+  }
+}
 
 #' @title Align NHD Dataset Names
 #' @description this function takes any NHDPlus dataset and aligns the attribute names with those used in nhdplusTools.
diff --git a/R/arcrest_tools.R b/R/arcrest_tools.R
index d36de1c7..8c4629e2 100644
--- a/R/arcrest_tools.R
+++ b/R/arcrest_tools.R
@@ -45,7 +45,7 @@ get_3dhp_service_info <- memoise::memoise(function() {
 #' @importFrom httr RETRY content
 #' @importFrom dplyr filter
 #' @importFrom methods as
-query_usgs_arcrest <- function(AOI = NULL,  ids = NULL,
+query_usgs_arcrest <- memoise::memoise(function(AOI = NULL,  ids = NULL,
                                type = NULL, where = NULL,
                                t_srs = NULL,
                                buffer = 0.5){
@@ -216,4 +216,4 @@ query_usgs_arcrest <- function(AOI = NULL,  ids = NULL,
     all_out[[l]] <- out
   }
   sf::st_sf(data.table::rbindlist(all_out))
-}
+}, ~memoise::timeout(nhdplusTools_memoise_timeout()), cache = nhdplusTools_memoise_cache())
diff --git a/R/geoserver_tools.R b/R/geoserver_tools.R
index b4d004fa..c70b1be5 100644
--- a/R/geoserver_tools.R
+++ b/R/geoserver_tools.R
@@ -31,7 +31,7 @@
 #' @importFrom methods as
 #' @importFrom xml2 read_xml
 
-query_usgs_geoserver <- function(AOI = NULL,  ids = NULL,
+query_usgs_geoserver <- memoise::memoise(function(AOI = NULL,  ids = NULL,
                                  type = NULL, filter = NULL,
                                  t_srs = NULL,
                                  buffer = 0.5) {
@@ -177,7 +177,7 @@ query_usgs_geoserver <- function(AOI = NULL,  ids = NULL,
     NULL
   }
 
-}
+}, ~memoise::timeout(nhdplusTools_memoise_timeout()), cache = nhdplusTools_memoise_cache())
 
 unify_types <- function(out) {
   all_class <- bind_rows(lapply(out, function(x) {
@@ -359,7 +359,7 @@ tc <- function(x) {
 #' @importFrom httr RETRY GET
 #' @importFrom jsonlite fromJSON
 
-extact_comid_nwis <- function(nwis){
+extact_comid_nwis <- memoise::memoise(function(nwis){
   # We could export this from dataRetrieval dataRetrieval:::pkg.env$nldi_base
   #but currently its not...
   baseURL  <- paste0(get_nldi_url(), "/linked-data/")
@@ -367,7 +367,7 @@ extact_comid_nwis <- function(nwis){
   c        <-  rawToChar(httr::RETRY("GET", url)$content)
   f.comid  <-  jsonlite::fromJSON(c, simplifyVector = TRUE)
   f.comid$features$properties$comid
-}
+}, ~memoise::timeout(nhdplusTools_memoise_timeout()), cache = nhdplusTools_memoise_cache())
 
 #' @importFrom sf st_make_valid st_as_sfc st_bbox st_buffer st_transform
 check_query_params <- function(AOI, ids, type, where, source, t_srs, buffer) {
diff --git a/R/get_nldi.R b/R/get_nldi.R
index 325a7bc0..56323a38 100644
--- a/R/get_nldi.R
+++ b/R/get_nldi.R
@@ -272,7 +272,7 @@ get_nldi_index <- function(location) {
 #' @importFrom httr GET
 #' @importFrom jsonlite fromJSON
 #' @noRd
-query_nldi <- function(query, base_path = "/linked-data", parse_json = TRUE) {
+query_nldi <- memoise::memoise(function(query, base_path = "/linked-data", parse_json = TRUE) {
   nldi_base_url <- paste0(get_nldi_url(), base_path)
 
   url <- paste(nldi_base_url, query,
@@ -303,7 +303,7 @@ query_nldi <- function(query, base_path = "/linked-data", parse_json = TRUE) {
     warning("Something went wrong accessing the NLDI.\n", e)
     NULL
   })
-}
+}, ~memoise::timeout(nhdplusTools_memoise_timeout()), cache = nhdplusTools_memoise_cache())
 
 #' @noRd
 check_nldi_feature <- function(nldi_feature, convert = TRUE) {