New force_identical_write arg

R/pin-meta.R

@@ -46,6 +46,8 @@ pin_meta <- function(board, name, version = NULL, ...) {
   UseMethod("pin_meta")
 }
 
+possibly_pin_meta <- possibly(pin_meta)
+
 multi_meta <- function(board, names) {
   meta <- map(names, possibly(pin_meta, empty_local_meta), board = board)
 

R/pin-read-write.R

@@ -64,6 +64,10 @@ pin_read <- function(board, name, version = NULL, hash = NULL, ...) {
 #'   use the default for `board`
 #' @param tags A character vector of tags for the pin; most important for
 #'   discoverability on shared boards.
+#' @param check_hash Check whether the pin contents are identical to the last
+#'   version if one exists (using the hash), and then **do not store** the pin
+#'   again. This argument does not check the pin metadata, only the pin
+#'   contents. Defaults to `FALSE`.
 #' @rdname pin_read
 #' @export
 pin_write <- function(board, x,
@@ -74,7 +78,8 @@ pin_write <- function(board, x,
                       metadata = NULL,
                       versioned = NULL,
                       tags = NULL,
-                      ...) {
+                      ...,
+                      check_hash = FALSE) {
   ellipsis::check_dots_used()
   check_board(board, "pin_write", "pin")
 
@@ -111,6 +116,16 @@ pin_write <- function(board, x,
   )
   meta$user <- metadata
 
+  if (check_hash) {
+    old_hash <- possibly_pin_meta(board, name)$pin_hash
+    if (!is.null(old_hash) && old_hash == meta$pin_hash) {
+      cli::cli_warn(
+        "The hash of pin {.val {name}} has not changed and will not be stored."
+      )
+      return(invisible(name))
+    }
+  }
+
   name <- pin_store(board, name, path, meta, versioned = versioned, x = x, ...)
   pins_inform("Writing to pin '{name}'")
   invisible(name)

R/testthat.R

@@ -162,6 +162,15 @@ test_api_versioning <- function(board) {
     )
   })
 
+  testthat::test_that("check_hash arg skips an identical subsequent write", {
+    orig <- local_pin(board, 1, check_hash = TRUE)
+    name <- local_pin(board, 1)
+    testthat::expect_warning(
+      pin_write(board, 1, name, check_hash = TRUE),
+      regexp = "has not changed and will not be stored"
+    )
+  })
+
   testthat::test_that("unversioned write overwrites single previous version", {
     name <- local_pin(board, 1)
     pin_write(board, 2, name, versioned = FALSE)