R/cache.R

Defines functions cached has_cache cache_pathname cache_path

#' @importFrom R.cache getCachePath
cache_path <- function(wx) {
  stopifnot(inherits(wx, "data.frame"))
  gps <- wx$gps[[1]]
  dir <- paste(sprintf("%s=%s", names(gps), gps), collapse=",")
  path <- getCachePath(dirs = c("bhgc.wx", dir))
  path
}

cache_pathname <- function(wx, ext = NULL) {
  path <- cache_path(wx)
  time <- wx$last_updated[[1]]
  time <- format(time, "%Y-%M-%dT%H:%m:%S")
  name <- gsub(":", "_", time)
  file.path(path, paste(c(name, ext), collapse = "."))
}

#' @importFrom utils file_test
has_cache <- function(wx, ext = "rds") {
  pathname <- cache_pathname(wx, ext = ext)
  file_test("-f", pathname)
}


cached <- function(wx) {
  stopifnot(inherits(wx, "data.frame"))

  cache_name <- cache_pathname(wx)
  pathname <- paste(cache_name, "tibble.rds", sep = ".")
  
  ## Used cached version, if it exists, otherwise cache
  if (file_test("-f", pathname)) {
    wx <- readRDS(pathname)
    attr(wx, "cache_name") <- cache_name
  } else {
    saveRDS(wx, file = pathname)
  }
  
  wx  
}
BHGC/bhgc.wx documentation built on Feb. 22, 2020, 8:05 a.m.