Changes to the cache API required by the new reticulate cache implementation

R/block.R

@@ -93,14 +93,20 @@ call_block = function(block) {
  }
  hash = paste(valid_path(params$cache.path, label), digest(content), sep = '_')
  params$hash = hash
- if (cache$exists(hash, params$cache.lazy) &&
+ xfun::dir_create(dirname(hash), showWarnings = FALSE)
+ if (cache_exists(params) &&
  isFALSE(params$cache.rebuild) &&
  params$engine != 'Rcpp') {
  if (opts_knit$get('verbose')) message(' loading cache from ', hash)
  cache$load(hash, lazy = params$cache.lazy)
- cache_engine(params)
+ if (params$engine != 'R' &&
+ !is.null(engine_cache <- cache_engines$get(params))) {
+ engine_cache$load(params)
+ }
  if (!params$include) return('')
  if (params$cache == 3) return(cache$output(hash))
+ } else {
+ purge_cache(params) # purge any invalid cache files
  }
  if (params$engine == 'R')
  cache$library(params$cache.path, save = FALSE) # load packages
@@ -156,11 +162,16 @@ block_exec = function(options) {
  output = paste(c(res.before, output, res.after), collapse = '')
  output = knit_hooks$get('chunk')(output, options)
  if (options$cache) {
- cache.exists = cache$exists(options$hash, options$cache.lazy)
- if (options$cache.rebuild || !cache.exists) block_cache(options, output, switch(
- options$engine,
- 'stan' = options$output.var, 'sql' = options$output.var, character(0)
- ))
+ cache.exists = cache_exists(options)
+ if (options$cache.rebuild || !cache.exists) {
+ block_cache(options, output, switch(
+ options$engine,
+ 'stan' = options$output.var, 'sql' = options$output.var, character(0)
+ ))
+ if (!is.null(engine_cache <- cache_engines$get(options))) {
+ engine_cache$save(options)
+ }
+ }
  }
  if (options$include) output else ''
 }
@@ -242,7 +253,7 @@ eng_r = function(options) {
  # guess plot file type if it is NULL
  if (keep != 'none') options$fig.ext = dev2ext(options)
 
- cache.exists = cache$exists(options$hash, options$cache.lazy)
+ cache.exists = cache_exists(options)
  evaluate = knit_hooks$get('evaluate')
  # return code with class 'source' if not eval chunks
  res = if (is_blank(code)) list() else if (isFALSE(ev)) {
@@ -346,16 +357,29 @@ block_cache = function(options, output, objects) {
  hash = options$hash
  outname = cache_output_name(hash)
  assign(outname, output, envir = knit_global())
- purge_cache(options)
  cache$library(options$cache.path, save = TRUE)
  cache$save(objects, outname, hash, lazy = options$cache.lazy)
 }
 
+cache_exists = function(options) {
+ R_cache_exists = cache$exists(options$hash, options$cache.lazy)
+ if (options$engine != 'R' &&
+ !is.null(engine_cache <- cache_engines$get(options))) {
+ R_cache_exists && engine_cache$exists(options)
+ } else {
+ R_cache_exists
+ }
+}
+
 purge_cache = function(options) {
  # purge my old cache and cache of chunks dependent on me
- cache$purge(paste0(valid_path(
- options$cache.path, c(options$label, dep_list$get(options$label))
- ), '_????????????????????????????????'))
+ glob_prefix = valid_path(options$cache.path, c(options$label, dep_list$get(options$label)))
+ glob_path = paste0(glob_prefix, '_', stringr::str_dup('?', 32)) # length of the MD5 hash
+ cache$purge(glob_path)
+ if (options$engine != 'R' &&
+ !is.null(engine_cache <- cache_engines$get(options))) {
+ engine_cache$purge(glob_path)
+ }
 }
 
 cache_globals = function(option, code) {

R/cache.R

@@ -4,14 +4,8 @@
 ## but it is using .rdb and .rdx as 'hard cache' (instead of cache in memory)
 new_cache = function() {
 
- cache_path = function(hash) {
- d = dirname(hash)
- if (!file.exists(d)) dir.create(d, showWarnings = FALSE, recursive = TRUE)
- file.path(d, basename(hash))
- }
-
- cache_purge = function(hash) {
- for (h in hash) unlink(paste(cache_path(h), c('rdb', 'rdx', 'RData'), sep = '.'))
+ cache_purge = function(glob_path) {
+ unlink(paste(glob_path, c('rdb', 'rdx', 'RData'), sep = '.'))
  }
 
  cache_save = function(keys, outname, hash, lazy = TRUE) {
@@ -20,18 +14,17 @@ new_cache = function() {
  out0 = outname
  on.exit(rm(list = out0, envir = knit_global()), add = TRUE)
  # keys are new variables created; outname is the text output of a chunk
- path = cache_path(hash)
  # add random seed to cache if exists
  if (exists('.Random.seed', envir = globalenv(), inherits = FALSE)) {
  copy_env(globalenv(), knit_global(), '.Random.seed')
  outname = c('.Random.seed', outname)
  }
  if (!lazy) outname = c(keys, outname)
- save(list = outname, file = paste(path, 'RData', sep = '.'), envir = knit_global())
+ save(list = outname, file = paste(hash, 'RData', sep = '.'), envir = knit_global())
  if (!lazy) return() # everything has been saved; no need to make lazy db
  # random seed is always load()ed
  keys = setdiff(keys, '.Random.seed')
- getFromNamespace('makeLazyLoadDB', 'tools')(knit_global(), path, variables = keys)
+ getFromNamespace('makeLazyLoadDB', 'tools')(knit_global(), hash, variables = keys)
  }
 
  save_objects = function(objs, label, path) {
@@ -54,12 +47,11 @@ new_cache = function() {
  }
 
  cache_load = function(hash, lazy = TRUE) {
- path = cache_path(hash)
- if (!is_abs_path(path)) path = file.path(getwd(), path)
- if (lazy) lazyLoad(path, envir = knit_global())
+ if (!is_abs_path(hash)) path = file.path(getwd(), hash)
+ if (lazy) lazyLoad(hash, envir = knit_global())
  # load output from last run if exists
- if (file.exists(path2 <- paste(path, 'RData', sep = '.'))) {
- load(path2, envir = knit_global())
+ if (file.exists(path <- paste(hash, 'RData', sep = '.'))) {
+ load(path, envir = knit_global())
  if (exists('.Random.seed', envir = knit_global(), inherits = FALSE))
  copy_env(knit_global(), globalenv(), '.Random.seed')
  name = cache_meta_name(hash)
@@ -89,7 +81,7 @@ new_cache = function() {
  cache_exists = function(hash, lazy = TRUE) {
  is.character(hash) &&
  all(file.exists(paste(
- cache_path(hash), if (lazy) c('rdb', 'rdx') else 'RData', sep = '.'
+ hash, c('RData', 'rdb', 'rdx')[if (lazy) 1:3 else 1], sep = '.'
  )))
  }
 

R/engine.R

@@ -51,6 +51,18 @@ knit_engines = new_defaults()
 #' @export
 cache_engines = new_defaults()
 
+# NOTE: these assignments don't change the closures namespace.
+cache_engines$.get = cache_engines$get
+cache_engines$get = function(options, ...) {
+ if (missing(options)) {
+ cache_engines$.get(...)
+ } else if (!is.null(cache_importer <- cache_engines$.get(options$engine, ...))) {
+ cache_importer(options)
+ } else {
+ NULL
+ }
+}
+
 #' An output wrapper for language engine output
 #'
 #' If you have designed a language engine, you may call this function in the end
@@ -277,12 +289,14 @@ eng_python = function(options) {
 }
 
 cache_eng_python = function(options) {
- if (isFALSE(options$python.reticulate)) return()
- # TODO: change this hack to reticulate::cache_eng_python(options) after
- # https://github.com/rstudio/reticulate/pull/167 is merged and released
- if (!'cache_eng_python' %in% ls(asNamespace('reticulate'))) return()
- fun = getFromNamespace('cache_eng_python', 'reticulate')
- fun(options)
+ # TODO: change this hack to reticulate::cache_eng_python after
+ # https://github.com/rstudio/reticulate/pull/1210 is merged and released
+ if (!isFALSE(options$python.reticulate) &&
+ 'cache_eng_python' %in% ls(asNamespace('reticulate'))) {
+ engine_cache = getFromNamespace('cache_eng_python', 'reticulate')
+ if (engine_cache$available(options)) return(engine_cache)
+ }
+ NULL
 }
 
 ## Java
@@ -936,12 +950,6 @@ get_engine = function(name) {
  }
 }
 
-cache_engine = function(options) {
- cache_fun = cache_engines$get(options$engine)
- if (!is.function(cache_fun)) return()
- cache_fun(options)
-}
-
 # possible values for engines (for auto-completion in RStudio)
 opts_chunk_attr$engine = as.list(sort(c('R', names(knit_engines$get()))))
 opts_chunk_attr[c('engine.path', 'engine.opts')] = list('character', 'character')

R/plot.R

@@ -146,7 +146,7 @@ save_plot = function(plot, name, dev, width, height, ext, dpi, options) {
 
  path = paste(name, ext, sep = '.')
  # when cache=2 and plot file exists, just return the filename
- if (options$cache == 2 && cache$exists(options$hash, options$cache.lazy)) {
+ if (options$cache == 2 && cache_exists(options)) {
  if (in_base_dir(!file.exists(path))) {
  purge_cache(options)
  stop('cannot find ', path, '; the cache has been purged; please re-compile')

tests/testit/test-cache.R

@@ -44,3 +44,28 @@ assert('dep_prev() sets dependencies on previous chunks', {
 })
 dep_list$restore()
 knit_code$restore()
+
+mock_cache = (function() {
+ noop_false = function(...) FALSE
+ noop_true = function(...) TRUE
+ list(available = noop_true, exists = noop_false,
+ load = noop_false, save = noop_false, purge = noop_false) # may return anything
+})()
+knit_engines$set(mock = function(...) "\n\nmock result\n\n")
+cache_engines$set(mock = function(...) mock_cache)
+knit_engine_cache = function() {
+ in_dir(tempdir(), {
+ txt = c(
+ '```{mock test, cache=TRUE, cache.path=""}',
+ 'mock code',
+ '```'
+ )
+ knit(text = txt, quiet = TRUE)
+ R_cache_file = list.files(pattern = "RData$")
+ t1 = file.mtime(R_cache_file)
+ knit(text = txt, quiet = TRUE)
+ t2 = file.mtime(R_cache_file)
+ t1 != t2 # missing "mock" cache should invalidate R cache
+ })
+}
+assert("missing external engine's cache invalidates R cache", knit_engine_cache())