From 76cfde28628088c74e30ce93596f573c3e034837 Mon Sep 17 00:00:00 2001 From: Paul Lietar Date: Wed, 18 Sep 2024 15:06:56 +0100 Subject: [PATCH] New version. - Replace the hack of returning TRUE with a class and instead return an R6 class with a `is_equal` method. - Don't print file diff by default, use a `verbose` flag to `print`. --- DESCRIPTION | 2 +- NAMESPACE | 6 +- R/compare.R | 167 +++++++++++++++++++------------ man/orderly_compare_packets.Rd | 23 ++--- tests/testthat/_snaps/compare.md | 88 ++++++++++++---- tests/testthat/test-compare.R | 109 +++++++++++--------- 6 files changed, 244 insertions(+), 151 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index 2bbe3654..4743a1d8 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,6 +1,6 @@ Package: orderly2 Title: Orderly Next Generation -Version: 1.99.39 +Version: 1.99.40 Authors@R: c(person("Rich", "FitzJohn", role = c("aut", "cre"), email = "rich.fitzjohn@gmail.com"), person("Robert", "Ashton", role = "aut"), diff --git a/NAMESPACE b/NAMESPACE index 91ee5976..1136bda8 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -1,12 +1,10 @@ # Generated by roxygen2: do not edit by hand -S3method("[",orderly_compare_packets) -S3method(format,orderly_compare_packets) +S3method(format,orderly_packet_diff) S3method(format,orderly_query) S3method(print,orderly_cleanup_status) -S3method(print,orderly_compare_packets) +S3method(print,orderly_packet_diff) S3method(print,orderly_query_explain) -S3method(summary,orderly_compare_packets) export(orderly_artefact) export(orderly_cleanup) export(orderly_cleanup_status) diff --git a/R/compare.R b/R/compare.R index 6e943ff1..ab5fb6a7 100644 --- a/R/compare.R +++ b/R/compare.R @@ -90,42 +90,52 @@ compare_files <- function(target, current, files, root, search_options) { ##' ##' @param target The id of the packet to use in the comparison. ##' @param current The id of the other packet against which to compare. -##' @param what One of "everything" (the default), "metadata", "files" or -##' "artefacts", retricting what components of the packet to compare. This is -##' useful when it is known for example that the source code of a report what -##' changed, and one is only interested in the effect on its output. +##' @param what One or more of "metadata", "files" and "artefacts", retricting +##' what components of the packet to compare. This is useful when it is known +##' for example that the source code of a report what changed, and one is only +##' interested in the effect on its output. ##' @param search_options Options for locating packet files. If there are no ##' copies of the files locally, they can be downloaded automatically from a ##' remote location on-demand if `allow_remote` is `TRUE`. ##' ##' @inheritParams orderly_metadata ##' -##' @return If the packets have identical contents, TRUE is returned. Otherwise -##' an object detailing the differences is returned. While the object can be -##' inspected, its contents is subject to change. In both cases, the returned -##' value has class `orderly_compare_packets`, allowing a user friendly -##' display of the result. +##' @return An R6 object of class `orderly_packet_diff` is returned. Printing +##' this object will show the difference in the two packets. Additionally, the +##' `is_equal` method of the object return a logical indicating whether any +##' difference was found. ##' ##' @export orderly_compare_packets <- function( - target, current, what = c("everything", "metadata", "files", "artefacts"), - search_options = NULL, root = NULL, locate = TRUE) { + target, current, search_options = NULL, root = NULL, locate = TRUE, + what = c("metadata", "files")) { + what <- rlang::arg_match(what, multiple = TRUE, + values = c("metadata", "files", "artefacts")) + if (length(what) == 0) { + cli::cli_abort("{.code what} must not be empty") + } + if ("artefacts" %in% what && "files" %in% what) { + cli::cli_abort('{.code what} must contain both "files" and "artefacts"') + } + validate_outpack_id(target, call = environment()) validate_outpack_id(current, call = environment()) - what <- rlang::arg_match(what) root <- root_open(root, locate = locate, require_orderly = FALSE, call = environment()) meta_target <- orderly_metadata(target, root = root) meta_current <- orderly_metadata(current, root = root) - if (what %in% c("everything", "metadata")) { - metadata_diff <- compare_metadata(meta_target, meta_current) + + if ("metadata" %in% what) { + metadata <- compare_metadata(meta_target, meta_current) } else { - metadata_diff <- NULL + metadata <- NULL } - if (what == "artefacts") { + if ("files" %in% what) { + files <- compare_filesets(meta_target$files, meta_current$files) + } else if ("artefacts" %in% what) { if (is.null(meta_target$custom$orderly) || is.null(meta_current$custom$orderly)) { cli::cli_abort("Cannot compare artefacts of non-orderly packets") @@ -136,96 +146,121 @@ orderly_compare_packets <- function( files <- compare_filesets( meta_target$files[meta_target$files$path %in% artefacts_target, ], meta_current$files[meta_current$files$path %in% artefacts_current, ]) - } else if (what %in% c("everything", "files")) { - files <- compare_filesets(meta_target$files, meta_current$files) - } else { - files <- data.frame(path = NULL, status = NULL) - } - - if (is.null(metadata_diff) && all(files$status == "unchanged")) { - ret <- TRUE } else { - idx <- files$status == "modified" - files$diff[idx] <- compare_files(target, current, files[idx, ]$path, - search_options = search_options, - root = root) - - ret <- list(packets = c(target = target, current = current), - metadata_diff = metadata_diff, - files = files) + files <- NULL } - class(ret) <- "orderly_compare_packets" + idx <- files$status == "modified" + files$diff[idx] <- compare_files(target, current, files[idx, ]$path, + search_options = search_options, + root = root) - ret + orderly_packet_diff$new(target, current, metadata, files) } -#' @export -format.orderly_compare_packets <- function(x, ...) { - cli::cli_format_method({ - if (isTRUE(x)) { - cli::cli_alert_success("Packets are identical") - } else { - target <- x$packets[[1]] - current <- x$packets[[2]] - - cli::cli_alert_info("Comparing packets {target} and {current}") +orderly_packet_diff <- R6::R6Class( + "orderly_packet_diff", + private = list( + what = NULL, + target = NULL, + current = NULL, + metadata = NULL, + files = NULL, - if (!is.null(x$metadata_diff)) { + print_metadata = function() { + if (!is.null(private$metadata)) { cli::cli_alert_warning("Packet metadata differs:") cli::cli_div(theme = list(div = list("margin-left" = 2))) - cli::cli_verbatim(as.character(x$metadata_diff)) + cli::cli_verbatim(as.character(private$metadata)) cli::cli_end() } + }, + + print_files = function(verbose) { + if (is.null(private$files)) { + return() + } - removed <- x$files[x$files$status == "removed", ] + removed <- private$files[private$files$status == "removed", ] if (nrow(removed) > 0) { cli::cli_alert_warning( - "The following files only exist in packet {current}:") + "The following files only exist in packet {private$current}:") cli::cli_ul(removed$path) } - added <- x$files[x$files$status == "added", ] + added <- private$files[private$files$status == "added", ] if (nrow(added) > 0) { cli::cli_alert_warning( - "The following files only exist in packet {target}:") + "The following files only exist in packet {private$target}:") cli::cli_ul(added$path) } - modified <- x$files[x$files$status == "modified", ] + modified <- private$files[private$files$status == "modified", ] if (nrow(modified) > 0) { - cli::cli_alert_warning(paste("The following files exist in both", - "packets but have different contents:")) + cli::cli_alert_warning( + paste("The following files exist in both packets but have", + "different contents:")) + cli::cli_ul() for (i in seq_len(nrow(modified))) { cli::cli_li("{modified$path[[i]]}") - if (!is.null(modified$diff[[i]])) { + if (verbose) { cli::cli_div(theme = list(div = list("margin-left" = 2))) cli::cli_verbatim(as.character(modified$diff[[i]])) cli::cli_end() } } + if (!verbose) { + cli::cli_alert_info(paste( + "Print the comparison with {.code verbose = TRUE} to display the", + "differences in the files' contents")) + } cli::cli_end() } } - }) -} + ), + public = list( + initialize = function(target, current, metadata, files) { + private$target <- target + private$current <- current + private$metadata <- metadata + private$files <- files + }, + + is_equal = function() { + is.null(private$metadata) && all(private$files$status == "unchanged") + }, + + format = function(verbose = FALSE) { + target <- private$target + current <- private$current + + cli::cli_format_method({ + if (self$is_equal()) { + cli::cli_alert_success( + "Packets {private$target} and {private$current} are identical") + } else { + cli::cli_alert_info( + "Comparing packets {private$target} and {private$current}") + + private$print_metadata() + private$print_files(verbose = verbose) + } + }) + } + ) +) -#' @export -print.orderly_compare_packets <- function(x, ...) { - cat(format(x, ...), sep = "\n") -} #' @export -`[.orderly_compare_packets` <- function(x, paths) { - x$files <- x$files[x$files$path %in% paths, , drop = FALSE] - x +format.orderly_packet_diff <- function(x, verbose = FALSE, ...) { + x$format(verbose = verbose) } + #' @export -summary.orderly_compare_packets <- function(object, ...) { - object$files$diff <- c() - object +print.orderly_packet_diff <- function(x, ...) { + cat(format(x, ...), sep = "\n") } diff --git a/man/orderly_compare_packets.Rd b/man/orderly_compare_packets.Rd index 0f7cec81..84194223 100644 --- a/man/orderly_compare_packets.Rd +++ b/man/orderly_compare_packets.Rd @@ -7,10 +7,10 @@ orderly_compare_packets( target, current, - what = c("everything", "metadata", "files", "artefacts"), search_options = NULL, root = NULL, - locate = TRUE + locate = TRUE, + what = c("metadata", "files") ) } \arguments{ @@ -18,11 +18,6 @@ orderly_compare_packets( \item{current}{The id of the other packet against which to compare.} -\item{what}{One of "everything" (the default), "metadata", "files" or -"artefacts", retricting what components of the packet to compare. This is -useful when it is known for example that the source code of a report what -changed, and one is only interested in the effect on its output.} - \item{search_options}{Options for locating packet files. If there are no copies of the files locally, they can be downloaded automatically from a remote location on-demand if \code{allow_remote} is \code{TRUE}.} @@ -38,13 +33,17 @@ for. If \code{TRUE}, then we looks in the directory given for \code{root} (or the working directory if \code{NULL}) and then up through its parents until it finds an \code{.outpack} directory or \code{orderly_config.yml}} + +\item{what}{One or more of "metadata", "files" and "artefacts", retricting +what components of the packet to compare. This is useful when it is known +for example that the source code of a report what changed, and one is only +interested in the effect on its output.} } \value{ -If the packets have identical contents, TRUE is returned. Otherwise -an object detailing the differences is returned. While the object can be -inspected, its contents is subject to change. In both cases, the returned -value has class \code{orderly_compare_packets}, allowing a user friendly -display of the result. +An R6 object of class \code{orderly_packet_diff} is returned. Printing +this object will show the difference in the two packets. Additionally, the +\code{is_equal} method of the object return a logical indicating whether any +difference was found. } \description{ Compare the metadata and contents of two packets. diff --git a/tests/testthat/_snaps/compare.md b/tests/testthat/_snaps/compare.md index 9754dcc0..fb7e25dc 100644 --- a/tests/testthat/_snaps/compare.md +++ b/tests/testthat/_snaps/compare.md @@ -1,21 +1,21 @@ -# Comparing a packet to itself returns TRUE +# Comparing a packet to itself returns an empty diff Code print(result) Output - v Packets are identical + v Packets 19700101-000000-00000001 and 19700101-000000-00000001 are identical # Comparing packets ignores ID and time differences Code print(result) Output - v Packets are identical + v Packets 19700101-000000-00000001 and 19700101-000000-00000002 are identical # Can compare packets with different metadata Code - print(all) + print(everything) Output i Comparing packets 19700101-000000-00000001 and 19700101-000000-00000002 ! Packet metadata differs: @@ -29,10 +29,63 @@ +--- + + Code + print(metadata) + Output + i Comparing packets 19700101-000000-00000001 and 19700101-000000-00000002 + ! Packet metadata differs: + < 19700101-000000-00000001 + > 19700101-000000-00000002 + @@ 7,5 / 7,5 @@ + $parameters + $parameters$A + < [1] "foo" + > [1] "bar" + + + +--- + + Code + print(files) + Output + v Packets 19700101-000000-00000001 and 19700101-000000-00000002 are identical + # Can compare packets with different file contents Code - print(all) + print(everything) + Output + i Comparing packets 19700101-000000-00000001 and 19700101-000000-00000002 + ! The following files exist in both packets but have different contents: + * data.R + * data.txt + i Print the comparison results with `verbose = TRUE` to display the differences in the files' contents + +--- + + Code + print(metadata) + Output + v Packets 19700101-000000-00000001 and 19700101-000000-00000002 are identical + +--- + + Code + print(files) + Output + i Comparing packets 19700101-000000-00000001 and 19700101-000000-00000002 + ! The following files exist in both packets but have different contents: + * data.R + * data.txt + i Print the comparison results with `verbose = TRUE` to display the differences in the files' contents + +--- + + Code + print(files, verbose = TRUE) Output i Comparing packets 19700101-000000-00000001 and 19700101-000000-00000002 ! The following files exist in both packets but have different contents: @@ -57,14 +110,16 @@ i Comparing packets 19700101-000000-00000001 and 19700101-000000-00000002 ! The following files exist in both packets but have different contents: * data.R - < 19700101-000000-00000001/data.R - > 19700101-000000-00000002/data.R - @@ 1,4 / 1,4 @@ - { - orderly_artefact("Output", "output.txt") - < writeLines(toString(2 + 1), "output.txt") - > writeLines(toString(1 + 2), "output.txt") - } + i Print the comparison results with `verbose = TRUE` to display the differences in the files' contents + +# Can detect newly declared artefact + + Code + print(artefacts) + Output + i Comparing packets 19700101-000000-00000001 and 19700101-000000-00000002 + ! The following files only exist in packet 19700101-000000-00000001: + * hello.txt # Can compare packets with binary contents @@ -74,10 +129,5 @@ i Comparing packets 19700101-000000-00000001 and 19700101-000000-00000002 ! The following files exist in both packets but have different contents: * data.rds - * data.txt - < 19700101-000000-00000001/data.txt - > 19700101-000000-00000002/data.txt - @@ 1 / 1 @@ - < Hello - > World + i Print the comparison results with `verbose = TRUE` to display the differences in the files' contents diff --git a/tests/testthat/test-compare.R b/tests/testthat/test-compare.R index 07502b9b..5d7ffb70 100644 --- a/tests/testthat/test-compare.R +++ b/tests/testthat/test-compare.R @@ -1,9 +1,9 @@ -test_that("Comparing a packet to itself returns TRUE", { +test_that("Comparing a packet to itself returns an empty diff", { root <- create_temporary_root() id <- create_random_packet(root) result <- orderly_compare_packets(id, id, root = root) - expect_true(result) + expect_true(result$is_equal()) expect_snapshot(print(result), transform = scrub_packets(id)) }) @@ -19,7 +19,7 @@ test_that("Comparing packets ignores ID and time differences", { expect_false(isTRUE(all.equal(meta1$time, meta2$time))) result <- orderly_compare_packets(id1, id2, root = root) - expect_true(result) + expect_true(result$is_equal()) expect_snapshot(print(result), transform = scrub_packets(id1, id2)) }) @@ -30,15 +30,17 @@ test_that("Can compare packets with different metadata", { p1 <- create_deterministic_packet(root, "data", list(A = "foo")) p2 <- create_deterministic_packet(root, "data", list(A = "bar")) - all <- orderly_compare_packets(p1, p2, root = root) - metadata <- orderly_compare_packets(p1, p2, what = "metadata", root = root) - files <- orderly_compare_packets(p1, p2, what = "files", root = root) + everything <- orderly_compare_packets(p1, p2, root = root) + metadata <- orderly_compare_packets(p1, p2, root = root, what = "metadata") + files <- orderly_compare_packets(p1, p2, root = root, what = "files") - expect_false(isTRUE(all)) - expect_false(isTRUE(metadata)) - expect_true(files) + expect_false(everything$is_equal()) + expect_false(metadata$is_equal()) + expect_true(files$is_equal()) - expect_snapshot(print(all), transform = scrub_packets(p1, p2)) + expect_snapshot(print(everything), transform = scrub_packets(p1, p2)) + expect_snapshot(print(metadata), transform = scrub_packets(p1, p2)) + expect_snapshot(print(files), transform = scrub_packets(p1, p2)) }) @@ -48,15 +50,19 @@ test_that("Can compare packets with different file contents", { p1 <- orderly_run_snippet(root, "data", writeLines("Hello", "data.txt")) p2 <- orderly_run_snippet(root, "data", writeLines("World", "data.txt")) - all <- orderly_compare_packets(p1, p2, root = root) - metadata <- orderly_compare_packets(p1, p2, what = "metadata", root = root) - files <- orderly_compare_packets(p1, p2, what = "files", root = root) + everything <- orderly_compare_packets(p1, p2, root = root) + metadata <- orderly_compare_packets(p1, p2, root = root, what = "metadata") + files <- orderly_compare_packets(p1, p2, root = root, what = "files") - expect_false(isTRUE(all)) - expect_true(metadata) - expect_false(isTRUE(files)) + expect_false(everything$is_equal()) + expect_true(metadata$is_equal()) + expect_false(files$is_equal()) - expect_snapshot(print(all), transform = scrub_packets(p1, p2)) + expect_snapshot(print(everything), transform = scrub_packets(p1, p2)) + expect_snapshot(print(metadata), transform = scrub_packets(p1, p2)) + expect_snapshot(print(files), transform = scrub_packets(p1, p2)) + expect_snapshot(print(files, verbose = TRUE), + transform = scrub_packets(p1, p2)) }) @@ -64,12 +70,12 @@ test_that("Can compare artefacts only", { root <- create_temporary_root() p1 <- orderly_run_snippet(root, "data", { - orderly_artefact("Output", "output.txt") + orderly_artefact(description = "Output", "output.txt") writeLines(toString(2 + 1), "output.txt") }) p2 <- orderly_run_snippet(root, "data", { - orderly_artefact("Output", "output.txt") + orderly_artefact(description = "Output", "output.txt") writeLines(toString(1 + 2), "output.txt") }) @@ -78,8 +84,8 @@ test_that("Can compare artefacts only", { # The packet files, in particular the source code, are different. However the # different snippets produce identical artefacts. - expect_false(isTRUE(files)) - expect_true(artefacts) + expect_false(files$is_equal()) + expect_true(artefacts$is_equal()) expect_snapshot(print(files), transform = scrub_packets(p1, p2)) }) @@ -93,20 +99,15 @@ test_that("Can detect newly declared artefact", { }) p2 <- orderly_run_snippet(root, "data", { - orderly_artefact("Output", "hello.txt") + orderly_artefact(description = "Output", "hello.txt") writeLines("Hello", "hello.txt") }) files <- orderly_compare_packets(p1, p2, what = "files", root = root) artefacts <- orderly_compare_packets(p1, p2, what = "artefacts", root = root) - f <- files$files[files$files$path == "hello.txt", ] - expect_equal(f$status, "unchanged") - - # When comparing artefacts, the file is reported as "added", because while it - # exists in the original packet, it was not an artefact. - f <- artefacts$files[artefacts$files$path == "hello.txt", ] - expect_equal(f$status, "added") + expect_false(artefacts$is_equal()) + expect_snapshot(print(artefacts), transform = scrub_packets(p1, p2)) }) @@ -114,27 +115,17 @@ test_that("Can compare packets with binary contents", { root <- create_temporary_root() p1 <- orderly_run_snippet(root, "data", { - orderly_artefact("Outputs", c("data.txt", "data.rds")) - writeLines("Hello", "data.txt") + orderly_artefact(description = "Output", "data.rds") saveRDS(1:10, "data.rds") }) p2 <- orderly_run_snippet(root, "data", { - orderly_artefact("Outputs", c("data.txt", "data.rds")) - writeLines("World", "data.txt") + orderly_artefact(description = "Output", "data.rds") saveRDS(11:20, "data.rds") }) result <- orderly_compare_packets(p1, p2, what = "artefacts", root = root) - expect_false(isTRUE(result)) - - # We can't render a diff for binary files, so these are set to NULL, unlike - # the text file. - text <- result$files[result$files$path == "data.txt", ] - binary <- result$files[result$files$path == "data.rds", ] - expect_false(is.null(text$diff[[1]])) - expect_true(is.null(binary$diff[[1]])) - + expect_false(result$is_equal()) expect_snapshot(print(result), transform = scrub_packets(p1, p2)) }) @@ -175,12 +166,32 @@ test_that("Can compare packets from remote", { orderly_compare_packets(p1, p2, root = here), "Unable to copy files, as they are not available locally") - # metadata comparison can be done without holding on to the files. - expect_no_error( - orderly_compare_packets(p1, p2, what = "metadata", root = here)) - - expect_message( + result <- suppressMessages({ orderly_compare_packets(p1, p2, search_options = list(allow_remote = TRUE), - root = here), - "Need to fetch 1 file.+from 1 location") + root = here) + }) + expect_false(result$is_equal()) +}) + + +test_that("Checks bad what argument", { + root <- create_temporary_root() + id <- create_random_packet(root) + + expect_error( + orderly_compare_packets(id, id, root = root, what = "xx"), + '`what` must be one of .*, not "xx"') + + expect_error( + orderly_compare_packets(id, id, root = root, what = character(0)), + "`what` must not be empty") + + expect_error( + orderly_compare_packets(id, id, root = root, what = TRUE), + "`what` must be a character vector") + + expect_error( + orderly_compare_packets(id, id, root = root, + what = c("files", "artefacts")), + '`what` must contain both "files" and "artefacts"') })