rotate_rds: the on_change_only argument now also accepts a `list(…

…)` of

  paramters to be passed on to `all.equal.data.table` when comparing `data.tables`

NEWS.md

@@ -3,6 +3,8 @@
 * `rotate()`, `backup()` and co. no longer fail on filenames that 
   contain  special regex characters (such as `*` or `+`)
 * `rotate()`, `backup()` and co. now work with hidden files
+* `rotate_rds`: the `on_change_only` argument now also accepts a `list()` of
+  paramters to be passed on to `all.equal.data.table` when comparing `data.tables`
 
 
 # rotor 0.3.5

R/rotate_rds.R

@@ -10,8 +10,10 @@
 #'   silently not rotate the file, while `rotate_rds_date()` will throw an
 #'   error.
 #'
-#' @param on_change_only `logical` scalar. Rotate only if `object` is different
-#'   from the object saved in `file`.
+#' @param on_change_only `logical` scalaror a `list`. Rotate only if `object`
+#'   is different from the object saved in `file`. If a `list`, arguments
+#'   that will be passed on to `data.table::all.equal` (only when both obects
+#'   are `data.tables`)
 #'
 #' @inheritParams base::saveRDS
 #' @inheritDotParams rotate
@@ -132,16 +134,18 @@ rotate_rds_internal <- function(
   fun
 ){
   assert(is_scalar_character(file))
-  assert(is_scalar_bool(on_change_only))
+  assert(is_scalar_bool(on_change_only) || is.list(on_change_only))
 
   if (file.exists(file)){
-    if (on_change_only){
+    if (isTRUE(on_change_only) || is.list(on_change_only)){
       comp <- readRDS(file)
+      if (is.list(on_change_only)){
+        extra_args <- on_change_only
+      } else {
+        extra_args <- list()
+      }
 
-      if (
-        identical(object, comp) ||
-        (inherits(object, "data.table") && inherits(comp, "data.table") && assert_namespace("data.table") && isTRUE(all.equal(object, comp)))
-      ){
+      if (objects_are_equal(object, comp, extra_args)){
         message(ObjectHasNotChangedMessage("not rotating: object has not changed"))
         return(invisible(file))
       }
@@ -160,3 +164,23 @@ rotate_rds_internal <- function(
 
   invisible(file)
 }
+
+
+
+
+objects_are_equal <- function(
+  x,
+  y,
+  extra_args = NULL
+){
+  if (identical(x, y)){
+    return(TRUE)
+  }
+
+  if (inherits(x, "data.table") && inherits(y, "data.table")){
+    assert_namespace("data.table")
+    return(isTRUE(do.call(all.equal, c(list(x, y), extra_args))))
+  }
+
+  FALSE
+}

tests/testthat/test_rotate_rds.R

@@ -124,3 +124,34 @@ test_that("rotate_rds_date on_change_only", {
   expect_message(rotate_rds_date(dt, tf, on_change_only = TRUE), class = "ObjectHasNotChangedMessage")
   prune_backups(tf, 0)
 })
+
+
+
+test_that("rotate_rds `on_change_only` works with arguments list", {
+  dir.create(td, recursive = TRUE)
+  on.exit(unlink(td, recursive = TRUE))
+
+  dt1 <- data.table::as.data.table(iris)
+  dt2 <- dt1[rev(seq_len(nrow(dt1))), ]
+  tf <- file.path(td, "testfile.rds")
+
+  expect_silent(rotate_rds(dt1, tf, on_change_only = TRUE))
+  expect_message(rotate_rds(dt1, tf, on_change_only = TRUE), class = "ObjectHasNotChangedMessage")
+  expect_message(rotate_rds(dt2, tf, on_change_only = list(ignore.row.order = TRUE)), class = "ObjectHasNotChangedMessage")
+  expect_message(rotate_rds(dt1, tf, on_change_only = TRUE), class = "ObjectHasNotChangedMessage")
+  expect_silent(rotate_rds(dt2, tf, on_change_only = TRUE))
+
+  expect_identical(n_backups(tf), 1L)
+  prune_backups(tf, 0)
+})
+
+
+
+
+test_that("objects_are_equal ", {
+  x <- data.table::data.table(a = 1:3)
+  y <- data.table::data.table(a = 3:1)
+
+  expect_false(objects_are_equal(x, y, extra_args = list()))
+  expect_true(objects_are_equal(x, y, extra_args = list(ignore.row.order = TRUE)))
+})