proper caching for installed packages

Author: lorenzwalthert

R/prepare.R

@@ -24,17 +24,14 @@ ref_install <- function(ref = "master",
       fs::dir_create(libpath_touchstone(ref)),
       .libPaths()
     )
-    last_change <- last_source_change()
     withr::local_libpaths(libpath)
     remotes::install_local(path_pkg,
       upgrade = "never", quiet = TRUE,
       dependencies = install_dependencies,
-      force = last_change != getOption("touchstone.timestamp_source_package")
+      force = !cache_up_to_date(ref, path_pkg)
     )
-    options("touchstone.timestamp_source_package" = last_change)
+    cache_update(ref, path_pkg)
     usethis::ui_done("Installed branch {ref} into {libpath[1]}.")
-
-    libpath
   }
 }
 
@@ -80,10 +77,44 @@ libpath_touchstone <- function(ref) {
 #' When did the package sources change last?
 #'
 #' @keywords internal
-last_source_change <- function() {
-  max(vctrs::vec_rbind(
-    fs::dir_info("R"),
-    fs::file_info("DESCRIPTION"),
-    if (fs::dir_exists("scr")) fs::dir_info("scr"),
-  )$modification_time)
+hash_pkg <- function() {
+  list(
+    tools::md5sum(c(
+      fs::dir_ls("R"),
+      "DESCRIPTION",
+      if (fs::dir_exists("scr")) fs::dir_info("scr")
+    ))
+  )
+}
+
+#' Cache package sources within a session
+#'
+#' This is required to make sure [remotes::install_local()] installs again
+#' when source code changed.
+#' @inheritParams ref_install
+#' @keywords internal
+cache_up_to_date <- function(ref, path_pkg) {
+  md5_hashes <- hash_pkg()
+  cache <- cache_get()
+  identical(md5_hashes, cache$md5_hashes[cache$ref == ref & cache$path_pkg == path_pkg])
+}
+
+#' @rdname cache_up_to_date
+#' @keywords internal
+cache_update <- function(ref, path_pkg) {
+  md5_hashes <- hash_pkg()
+  cache <- cache_get()
+  stopifnot(sum(cache$ref[cache$path_pkg == path_pkg] == ref) <= 1)
+  cache <- cache[(!(cache$ref == ref) & (cache$path_pkg == path_pkg)), ]
+  cache <- vctrs::vec_rbind(
+    cache, tibble::tibble(ref, md5_hashes, path_pkg)
+  )
+  options("touchstone.hash_source_package" = cache)
+}
+
+
+#' @rdname cache_up_to_date
+#' @keywords internal
+cache_get <- function() {
+  getOption("touchstone.hash_source_package")
 }

R/zzz.R

@@ -1,11 +1,14 @@
 .onLoad <- function(libname, pkgname) {
   op <- options()
+  cache <- tibble::tibble(
+    ref = character(), md5_hashes = list(), path_pkg = character()
+  )
   op.touchstone <- list(
     "touchstone.skip_install" = FALSE,
     "touchstone.dir" = "touchstone",
     # how many times should inner loop be ran in benchmark_run_iteration
     "touchstone.n_iterations" = 1,
-    "touchstone.timestamp_source_package" = Sys.time()
+    "touchstone.hash_source_package" = cache
   )
   toset <- !(names(op.touchstone) %in% names(op))
   if (any(toset)) options(op.touchstone[toset])

man/cache_up_to_date.Rd

@@ -18,3 +18,45 @@ test_that("can install in isolated repos", {
     withr::with_libpaths(lib_path2, bli44:::x), 55
   )
 })
+
+test_that("cache works", {
+  ref <- "devel"
+  withr::local_options(list(
+    "touchstone.hash_source_package" = tibble::tibble(
+      ref = character(), md5_hashes = list(), path_pkg = character()
+    )
+  ))
+  name_tmp_pkg <- "bli44"
+  path_pkg <- local_package(name_tmp_pkg, r_sample = "x <- 55")
+
+  expect_equal(nrow(cache_get()), 0)
+  expect_false(cache_up_to_date(ref, path_pkg))
+  cache_update(ref, path_pkg)
+  expect_equal(nrow(cache_get()), 1)
+  print(getwd())
+  writeLines(c("x <- 55"), "R/sample.R")
+  expect_true(cache_up_to_date(ref, path_pkg))
+  writeLines(c("22"), "R/sample.R")
+  expect_false(cache_up_to_date(ref, path_pkg))
+  expect_false(cache_up_to_date(ref, path_pkg))
+  cache_update(ref, path_pkg)
+  expect_true(cache_up_to_date(ref, path_pkg))
+
+  # new ref
+  ref <- "m2"
+  expect_equal(nrow(cache_get()), 1)
+  # prepare for case that remotes would ever have global cache across libraries
+  # (currently not the case) and could think "version has not changed, just copying"
+  expect_false(cache_up_to_date(ref, path_pkg))
+  cache_update(ref, path_pkg)
+  expect_equal(nrow(cache_get()), 2)
+  cache_update(ref, path_pkg)
+  expect_true(cache_up_to_date(ref, path_pkg))
+
+  # new root
+  path_pkg <- local_package(name_tmp_pkg, r_sample = "c")
+  expect_equal(nrow(cache_get()), 2)
+  expect_false(cache_up_to_date(ref, path_pkg))
+  cache_update(ref, path_pkg)
+  expect_true(cache_up_to_date(ref, path_pkg))
+})