add read_absmaps caching

re runapp-aus#63

R/read_absmaps.R

@@ -16,6 +16,8 @@
 #' If TRUE, `strip_year_suffix` is run before returning the object, removing
 #' the `_year` suffix from variable names.
 #'
+#' @param export_dir path to a directory to store the desired sf object. \code{tempdir()} by default.
+#'
 #' @return an sf object.
 #'
 #'
@@ -29,11 +31,12 @@
 #'
 #' @export
 #'
-#'
+
 read_absmap <- function(name = NULL,
                         area = NULL,
                         year = NULL,
-                        remove_year_suffix = FALSE) {
+                        remove_year_suffix = FALSE,
+                        export_dir = tempdir()) {
 
   if (all(is.null(name), is.null(area), is.null(year))) {
     stop("Please enter a name (eg name = 'sa32016') or an area/year combination (eg area = 'sa3', year = '2016').")
@@ -47,6 +50,10 @@ read_absmap <- function(name = NULL,
     warning("Both name and area/year entered. Defaulting to name value: ", name)
   }
 
+  if (!dir.exists(export_dir)) {
+    stop("export_dir provided does not exist: ", export_dir)
+  }
+
   # Define name
   if (is.null(name)) name <- paste0(area, year)
   name <- stringr::str_to_lower(name)
@@ -56,9 +63,19 @@ read_absmap <- function(name = NULL,
   url <- paste0(base_url, name, ".rda")
 
   # download to temporary file
-  out_path <- tempfile(fileext = ".rda")
-  download.file(url,
-                destfile = out_path)
+  out_path <- file.path(export_dir, paste0(name, ".rda"))
+
+  if (!file.exists(out_path)) {
+    download.file(url,
+                  destfile = out_path)
+  } else {
+    if (stringr::str_detect(export_dir, "var.folders")) {
+      message("Reading ", name, " file found in temporary folder")
+    } else {
+      message("Reading ", name, " file found in ", export_dir)
+    }
+
+  }
 
   load(out_path)
 
@@ -69,3 +86,4 @@ read_absmap <- function(name = NULL,
   return(d)
 
 }
+

tests/testthat/test-read_absmaps.R

@@ -1,7 +1,8 @@
-test_that("read_absmaps() works", {
+test_that("read_absmaps() retrieves objects", {
 
   expect_type(read_absmap("sa42016"), "list")
-  expect_type(read_absmap("SA42016"), "list")
+  expect_identical(read_absmap("SA42016"),
+                   read_absmap("sa42016"))
 
   expect_identical(names(read_absmap("state2021")),
                    c("state_code_2021",
@@ -10,16 +11,40 @@ test_that("read_absmaps() works", {
                      "cent_lat",
                      "cent_long",
                      "geometry"))
+})
 
-  expect_identical(names(read_absmap("SA32016")),
-                   c("sa3_code_2016", "sa3_name_2016", "sa4_code_2016",
-                     "sa4_name_2016", "gcc_code_2016", "gcc_name_2016",
-                     "state_code_2016", "state_name_2016", "areasqkm_2016", "cent_long",
+test_that("read_absmaps() remove_year_suffix param works", {
+  expect_identical(names(read_absmap("sa42016", remove_year_suffix = TRUE)),
+                   c("sa4_code", "sa4_name", "gcc_code", "gcc_name",
+                     "state_code", "state_name", "areasqkm", "cent_long",
                      "cent_lat", "geometry"))
+})
+
 
+test_that("read_absmaps() input checking works", {
   # errors
   expect_error(read_absmap(), regexp = "Please")
   expect_error(read_absmap(area = "sa2"), regexp = "Please")
   expect_error(read_absmap(year = 2011), regexp = "Please")
+  expect_error(read_absmap(name = "sa42021", export_dir = "this-doesnt-exist"),
+               regexp = "does not exist")
+
+})
+
+test_that("caching for read_absmaps() works", {
+
+  new_dir <- file.path(tempdir(), "test-data")
+  dir.create(new_dir)
+
+  read_absmap("sa42021")
+  # will be cached
+  expect_message(read_absmap("sa42021"), regexp = "Reading")
+
+  # will have to download again
+  expect_silent(read_absmap("sa42021", export_dir = new_dir))
+  # will be cached
+  expect_message(read_absmap("sa42021", export_dir = new_dir))
+
+  unlink(new_dir)
 
 })