r-lib / memoise

Easy memoisation for R
https://memoise.r-lib.org
Other
317 stars 56 forks source link

Move to cachem breaks custom cache objects #117

Closed krlmlr closed 3 years ago

krlmlr commented 3 years ago

How can we make this compatible with both versions of memoise?

1e47c363786d560b41316bf749480433d42ca304, current

library(rlang)

cache_attach <- function(algo = "sha512", base_attach = attach, name = paste0(utils::packageName(), "_cache")) {
  force(algo)

  if (!is_attached(name)) {
    env <- new_environment(list(...cache = new_environment()))
    base_attach(env, pos = length(search()) - 1, name = name)
  }
  cache <- search_env(name)$...cache

  cache_reset <- function() {
    rm(list = ls(cache), envir = cache)
  }

  cache_set <- function(key, value) {
    assign(key, value, envir = cache)
  }

  cache_get <- function(key) {
    get(key, envir = cache, inherits = FALSE)
  }

  cache_has_key <- function(key) {
    exists(key, envir = cache, inherits = FALSE)
  }

  list(
    digest = function(...) digest::digest(..., algo = algo),
    reset = cache_reset,
    set = cache_set,
    get = cache_get,
    has_key = cache_has_key,
    keys = function() ls(cache)
  )
}

cachee <- function() "foo"
cachee()
#> [1] "foo"

cachee <<- memoise::memoise(cachee, cache = cache_attach(name = "test"))
cachee()
#> Error in get(key, envir = cache, inherits = FALSE): object 'b41b0123bcd8e4b82ee65ffcbcdb06a8' not found

Created on 2021-01-08 by the reprex package (v0.3.0)

83304eb0d42af699f0f974a4f161569e4a82916f, before cachem

library(rlang)

cache_attach <- function(algo = "sha512", base_attach = attach, name = paste0(utils::packageName(), "_cache")) {
  force(algo)

  if (!is_attached(name)) {
    env <- new_environment(list(...cache = new_environment()))
    base_attach(env, pos = length(search()) - 1, name = name)
  }
  cache <- search_env(name)$...cache

  cache_reset <- function() {
    rm(list = ls(cache), envir = cache)
  }

  cache_set <- function(key, value) {
    assign(key, value, envir = cache)
  }

  cache_get <- function(key) {
    get(key, envir = cache, inherits = FALSE)
  }

  cache_has_key <- function(key) {
    exists(key, envir = cache, inherits = FALSE)
  }

  list(
    digest = function(...) digest::digest(..., algo = algo),
    reset = cache_reset,
    set = cache_set,
    get = cache_get,
    has_key = cache_has_key,
    keys = function() ls(cache)
  )
}

cachee <- function() "foo"
cachee()
#> [1] "foo"

cachee <<- memoise::memoise(cachee, cache = cache_attach(name = "test"))
cachee()
#> [1] "foo"

Created on 2021-01-08 by the reprex package (v0.3.0)

CC @wch.

wch commented 3 years ago

memoise() identifies old-style caches by passing them to is_old_cache(). It looks like that function is a bit too stringent for the cache you've defined:

x <- cache_attach(name = "test")
memoise:::is_old_cache(x)
#> [1] FALSE

In particular, it's looking for a $drop_key() method, which cache_attach doesn't have.

https://github.com/r-lib/memoise/blob/1e47c363786d560b41316bf749480433d42ca304/R/old_cache.R#L27-L34

I guess it might make sense to not check for $drop_key, since it's not totally necessary for the memoise() function to work.