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

@@ -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 = "[email protected]"),
              person("Robert", "Ashton", role = "aut"),

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)

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")
 }