New force_identical_write arg (#735)

* New `check_hash` arg

* Add test

* Update docs

* Clarify docs about no checking of metadata

* Better warning message

* Update NEWS

* Update test

* Apply suggestions from code review

Co-authored-by: Hadley Wickham <[email protected]>

* Use `cli_inform()` instead of warning

* Change arg to `compare_hash`, default of `TRUE`

* Update a couple of tests for default of `TRUE`

---------

Co-authored-by: Hadley Wickham <[email protected]>

NEWS.md

@@ -1,5 +1,13 @@
 # pins (development version)
 
+## Breaking changes
+
+* `pin_write()` no longer writes identical pin contents by default, and gains a
+  `force_identical_write` argument for writing even when the pin contents are 
+  identical to the last version (#735).
+
+## Other improvements
+
 * The `print` method for boards no longer calls `pin_list()` internally (#718).
 
 * `board_s3()` now uses pagination for listing and versioning (#719, @mzorko).

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,9 @@ 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 force_identical_write Store the pin even if the pin contents are
+#'   identical to the last version (compared using the hash). Only the pin
+#'   contents are compared, not the pin metadata. Defaults to `FALSE`.
 #' @rdname pin_read
 #' @export
 pin_write <- function(board, x,
@@ -74,7 +77,8 @@ pin_write <- function(board, x,
                       metadata = NULL,
                       versioned = NULL,
                       tags = NULL,
-                      ...) {
+                      ...,
+                      force_identical_write = FALSE) {
   ellipsis::check_dots_used()
   check_board(board, "pin_write", "pin")
 
@@ -111,6 +115,17 @@ pin_write <- function(board, x,
   )
   meta$user <- metadata
 
+  if (!force_identical_write) {
+    old_hash <- possibly_pin_meta(board, name)$pin_hash
+    if (identical(old_hash, meta$pin_hash)) {
+      pins_inform(c(
+        "!" = "The hash of pin {.val {name}} has not changed.",
+        "*" = "Your pin 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,16 @@ test_api_versioning <- function(board) {
     )
   })
 
+  testthat::test_that("force_identical_write arg skips an identical subsequent write", {
+    orig <- local_pin(board, 1)
+    name <- local_pin(board, 1, force_identical_write = TRUE)
+    ui_loud()
+    testthat::expect_message(
+      pin_write(board, 1, name),
+      regexp = "Your pin 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)

R/utils.R

@@ -53,10 +53,10 @@ modifyList <- function(x, y) {
 
 last <- function(x) x[[length(x)]]
 
-pins_inform <- function(...) {
+pins_inform <- function(msg) {
   opt <- getOption("pins.quiet", NA)
   if (identical(opt, FALSE) || (identical(opt, NA))) {
-    inform(glue(..., .envir = caller_env()))
+    cli::cli_inform(msg, .envir = caller_env())
   }
 }
 

tests/testthat/_snaps/board_folder.md

@@ -49,12 +49,12 @@
       Creating new version '20130104T050607Z-xxxxx'
       Writing to pin 'x'
     Code
-      pin_write(b, 1:5, "x", type = "rds")
+      pin_write(b, 1:6, "x", type = "rds")
     Message
       Replacing version '20130104T050607Z-xxxxx' with '20130204T050607Z-yyyyy'
       Writing to pin 'x'
     Code
-      pin_write(b, 1:6, "x", type = "rds")
+      pin_write(b, 1:7, "x", type = "rds")
     Message
       Replacing version '20130204T050607Z-yyyyy' with '20130304T050607Z-zzzzz'
       Writing to pin 'x'

tests/testthat/_snaps/pin_versions.md

@@ -33,7 +33,7 @@
 
     Code
       board %>% pin_write(1:10, "x")
-      board %>% pin_write(1:10, "x")
+      board %>% pin_write(1:10, "x", force_identical_write = TRUE)
     Condition
       Error in `pin_store()`:
       ! The new version "20120304T050607Z-xxxxx" is the same as the most recent version.

tests/testthat/test-board_connect.R

@@ -46,11 +46,11 @@ test_that("can update access_type", {
   # default is acl
   expect_equal(rsc_content_info(board, guid)$access_type, "acl")
 
-  pin_write(board, 1:5, name, access_type = "logged_in")
+  pin_write(board, 1:6, name, access_type = "logged_in")
   expect_equal(rsc_content_info(board, guid)$access_type, "logged_in")
 
   # writing again doesn't change the access_type
-  pin_write(board, 1:5, name)
+  pin_write(board, 1:7, name)
   expect_equal(rsc_content_info(board, guid)$access_type, "logged_in")
 })
 

tests/testthat/test-board_folder.R

@@ -86,8 +86,8 @@ test_that("generates useful messages", {
   ui_loud()
   b <- board_temp()
   expect_snapshot({
-    pin_write(b, 1:5, "x", type = "rds")
     pin_write(b, 1:5, "x", type = "rds")
     pin_write(b, 1:6, "x", type = "rds")
+    pin_write(b, 1:7, "x", type = "rds")
   })
 })

tests/testthat/test-pin_versions.R

@@ -40,7 +40,7 @@ test_that("informative error for writing with same version", {
   board <- board_temp(versioned = TRUE)
   expect_snapshot(error = TRUE, {
     board %>% pin_write(1:10, "x")
-    board %>% pin_write(1:10, "x")
+    board %>% pin_write(1:10, "x", force_identical_write = TRUE)
   })
 })