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`.
mrc-ide · Sep 18, 2024 · 1bd1857 · 1bd1857
1 parent 29ae5ec
commit 1bd1857
Show file tree

Hide file tree

Showing 5 changed files with 229 additions and 134 deletions.
diff --git 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_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
@@ -108,24 +108,36 @@ compare_files <- function(target, current, files, root, search_options) {
 ##'
 ##' @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 +148,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()
       }
+    },
 
-      removed <- x$files[x$files$status == "removed", ]
+    print_files = function(verbose) {
+      if (is.null(private$files)) {
+        return()
+      }
+
+      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 results 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_compare_packets <- function(x, ...) {
+  cat(format(x, ...), sep = "\n")
 }
diff --git a/man/orderly_compare_packets.Rd b/man/orderly_compare_packets.Rd
diff --git 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