Make pulling metadata more chatty

R/location.R

@@ -280,20 +280,40 @@ orderly_location_list <- function(verbose = FALSE, root = NULL) {
 ##'   locations are always up to date and pulling metadata from them
 ##'   does nothing.
 ##'
+##' @param quiet Logical, indicating if we should print information
+##'   about locations searched and metadata found.  If not given, we
+##'   use the option of `orderly.quiet`, defaulting to `TRUE`.
+##'
 ##' @inheritParams orderly_metadata
 ##'
 ##' @return Nothing
 ##'
 ##' @export
-orderly_location_pull_metadata <- function(location = NULL, root = NULL) {
+orderly_location_pull_metadata <- function(location = NULL, quiet = NULL,
+                                           root = NULL) {
   root <- root_open(root, require_orderly = FALSE)
   location_name <- location_resolve_valid(location, root,
                                           include_local = FALSE,
                                           include_orphan = FALSE,
                                           allow_no_locations = TRUE,
                                           environment())
+  quiet <- orderly_quiet(quiet)
+  if (!quiet) {
+    cli::cli_alert_info(paste(
+      "Fetching metadata from {length(location_name)} location{?s}:",
+      "{squote({location_name})}"))
+  }
   for (name in location_name) {
-    location_pull_metadata(name, root, environment())
+    res <- location_pull_metadata(name, root)
+    if (!quiet) {
+      if (res$total > 0) {
+        cli::cli_alert_success(paste(
+          "Found {res$total} packet{?s} at '{name}', of which",
+          "{res$new} {?is/are} new"))
+      } else {
+        cli::cli_alert_warning("No metadata found at '{name}'")
+      }
+    }
   }
 
   id_deorphan <- intersect(root$index$location(location_name)$packet,
@@ -497,7 +517,7 @@ orderly_location_custom <- function(driver, ...) {
 }
 
 
-location_pull_metadata <- function(location_name, root, call) {
+location_pull_metadata <- function(location_name, root, call = parent.frame()) {
   index <- root$index$data()
   driver <- location_driver(location_name, root)
 
@@ -572,6 +592,8 @@ location_pull_metadata <- function(location_name, root, call) {
     mark_packet_known(new_loc$packet[[i]], location_name, new_loc$hash[[i]],
                       new_loc$time[[i]], root)
   }
+
+  list(total = length(is_new), new = sum(is_new))
 }
 
 

R/query_index.R

@@ -87,7 +87,7 @@ new_query_index <- function(root, options) {
   root <- root_open(root, require_orderly = FALSE)
 
   if (options$pull_metadata) {
-    orderly_location_pull_metadata(options$location, root)
+    orderly_location_pull_metadata(options$location, root = root)
   }
   idx <- root$index$data()
   metadata <- idx$metadata

R/util.R

@@ -714,3 +714,12 @@ fill_missing_names <- function(x) {
   }
   x
 }
+
+
+orderly_quiet <- function(quiet, call = parent.frame()) {
+  if (is.null(quiet)) {
+    getOption("orderly.quiet", FALSE)
+  } else {
+    assert_scalar_logical(quiet, call = call)
+  }
+}

tests/testthat/helper-orderly.R

@@ -1,7 +1,8 @@
 options(outpack.schema_validate =
           requireNamespace("jsonvalidate", quietly = TRUE) &&
           packageVersion("jsonvalidate") >= "1.4.0",
-        orderly_index_progress = FALSE)
+        orderly_index_progress = FALSE,
+        orderly.quiet = TRUE)
 
 
 test_prepare_orderly_example <- function(examples, ...) {

tests/testthat/test-location.R

@@ -1026,7 +1026,7 @@ test_that("avoid duplicated metadata", {
 
   mockery::stub(location_pull_metadata, "location_driver", mock_location_driver)
   err <- expect_error(
-    location_pull_metadata("server", here, NULL),
+    location_pull_metadata("server", root = here),
     "Duplicate metadata reported from location 'server'")
   expect_equal(names(err$body), c("x", "i", "i"))
   expect_equal(err$body[[1]],
@@ -1136,3 +1136,39 @@ test_that("early exit if no orphans", {
   expect_silent(res <- orderly_prune_orphans(root = root))
   expect_equal(res, character())
 })
+
+
+test_that("be chatty when pulling packets", {
+  withr::local_options(orderly.quiet = FALSE)
+  here <- create_temporary_root()
+  there <- create_temporary_root()
+  orderly_location_add_path("server", path = there$path, root = here)
+
+  res <- evaluate_promise(orderly_location_pull_metadata(root = here))
+  expect_length(res$messages, 2)
+  expect_match(res$messages[[1]],
+               "Fetching metadata from 1 location: 'server'")
+  expect_match(res$messages[[2]],
+               "No metadata found at 'server'")
+
+  id1 <- create_random_packet(there)
+  id2 <- create_random_packet(there)
+
+  res <- evaluate_promise(orderly_location_pull_metadata(root = here))
+  expect_length(res$messages, 2)
+  expect_match(res$messages[[1]],
+               "Fetching metadata from 1 location: 'server'")
+  expect_match(res$messages[[2]],
+               "Found 2 packets at 'server', of which 2 are new")
+
+  res <- evaluate_promise(orderly_location_pull_metadata(root = here))
+  expect_length(res$messages, 2)
+  expect_match(res$messages[[2]],
+               "Found 2 packets at 'server', of which 0 are new")
+
+  id3 <- create_random_packet(there)
+  res <- evaluate_promise(orderly_location_pull_metadata(root = here))
+  expect_length(res$messages, 2)
+  expect_match(res$messages[[2]],
+               "Found 3 packets at 'server', of which 1 is new")
+})