Merge pull request #91 from mrc-ide/mrc-4462

mrc-4462: more cli errors

R/config.R

@@ -1,4 +1,4 @@
-orderly_config_read <- function(path) {
+orderly_config_read <- function(path, call = NULL) {
   filename <- file.path(path, "orderly_config.yml")
   assert_file_exists(basename(filename), workdir = path,
                      name = "Orderly configuration")
@@ -8,7 +8,8 @@ orderly_config_read <- function(path) {
     assert_named(raw)
   }
 
-  raw <- resolve_envvar(raw, orderly_envir_read(path), "orderly_config.yml")
+  raw <- resolve_envvar(raw, orderly_envir_read(path, call),
+                        "orderly_config.yml")
 
   check <- list(
     minimum_orderly_version = orderly_config_validate_minimum_orderly_version,
@@ -23,29 +24,34 @@ orderly_config_read <- function(path) {
   on.exit(setwd(owd))
   dat <- list()
   for (x in names(check)) {
-    dat[[x]] <- check[[x]](raw[[x]], filename)
+    dat[[x]] <- check[[x]](raw[[x]], filename, call)
   }
 
   dat
 }
 
 
-orderly_config_validate_minimum_orderly_version <- function(value, filename) {
+orderly_config_validate_minimum_orderly_version <- function(value, filename,
+                                                            call = NULL) {
   assert_scalar_character(value)
   version <- numeric_version(value)
   if (version < numeric_version("1.99.0")) {
-    stop("Migrate from version 1, see docs that we need to write still...")
+    cli::cli_abort(
+      c("Detected old orderly version, you need to migrate to orderly2",
+        i = 'Please see documentation at vignette("migrating")'),
+      call = call)
   }
   if (version > current_orderly_version()) {
-    stop(sprintf(
+    cli::cli_abort(sprintf(
       "orderly version '%s' is required, but only '%s' installed",
-      version, current_orderly_version()))
+      version, current_orderly_version()),
+      call = call)
   }
   version
 }
 
 
-orderly_config_validate_plugins <- function(plugins, filename) {
+orderly_config_validate_plugins <- function(plugins, filename, call = NULL) {
   if (is.null(plugins)) {
     return(NULL)
   }
@@ -61,7 +67,7 @@ orderly_config_validate_plugins <- function(plugins, filename) {
 }
 
 
-orderly_envir_read <- function(path) {
+orderly_envir_read <- function(path, call = NULL) {
   filename <- file.path(path, "orderly_envir.yml")
   if (!file.exists(filename)) {
     return(NULL)
@@ -76,9 +82,13 @@ orderly_envir_read <- function(path) {
   n <- lengths(dat)
   nok <- n != 1L
   if (any(nok)) {
-    stop(sprintf("Expected all elements of %s to be scalar (check %s)",
-                 basename(filename),
-                 paste(squote(names(dat)[nok]), collapse = ", ")))
+    err <- sprintf("Expected '%s' to be scalar, but had length %d",
+                   names(dat)[nok], n[nok])
+    cli::cli_abort(
+      c("All elements of '{basename(filename)}' must be scalar",
+        set_names(err, rep("x", length(err))),
+        i = "Working directory was '{dirname(filename)}'"),
+      call = call)
   }
   vcapply(dat[n == 1], as.character)
 }

R/metadata.R

@@ -24,7 +24,7 @@
 orderly_strict_mode <- function() {
   p <- get_active_packet()
   if (!is.null(p)) {
-    prevent_multiple_calls(p, "strict_mode")
+    prevent_multiple_calls(p, "strict_mode", environment())
     p$orderly2$strict <- static_orderly_strict_mode(list())
   }
   invisible()
@@ -54,21 +54,22 @@ static_orderly_strict_mode <- function(args) {
 orderly_parameters <- function(...) {
   p <- get_active_packet()
   if (is.null(p)) {
-    pars <- static_orderly_parameters(list(...))
+    call <- environment()
     envir <- parent.frame()
-    check_parameters_interactive(envir, pars)
+    pars <- static_orderly_parameters(list(...), call)
+    check_parameters_interactive(envir, pars, call)
   }
 
   invisible()
 }
 
 
-static_orderly_parameters <- function(args) {
+static_orderly_parameters <- function(args, call) {
   if (length(args) == 0L) {
     return(NULL)
   }
   assert_named(args, unique = TRUE, name = "Arguments to 'orderly_parameters'")
-  check_parameter_values(args, TRUE)
+  check_parameter_values(args, TRUE, call)
 
   args
 }
@@ -77,7 +78,7 @@ static_orderly_parameters <- function(args) {
 current_orderly_parameters <- function(src, envir) {
   dat <- orderly_read(src)
   pars <- static_orderly_parameters(dat$parameters)
-  values <- check_parameters_interactive(envir, pars)
+  values <- check_parameters_interactive(envir, pars, NULL)
   values
 }
 
@@ -116,7 +117,7 @@ orderly_description <- function(display = NULL, long = NULL, custom = NULL) {
 
   p <- get_active_packet()
   if (!is.null(p)) {
-    prevent_multiple_calls(p, "description")
+    prevent_multiple_calls(p, "description", environment())
     p$orderly2$description <-
       list(display = display, long = long, custom = custom)
   }
@@ -310,7 +311,7 @@ static_orderly_dependency <- function(args) {
 ##' @return Undefined
 ##' @export
 orderly_shared_resource <- function(...) {
-  files <- validate_shared_resource(list(...))
+  files <- validate_shared_resource(list(...), environment())
   ctx <- orderly_context(rlang::caller_env())
 
   files <- copy_shared_resource(ctx$root, ctx$path, ctx$config, files)
@@ -324,15 +325,19 @@ orderly_shared_resource <- function(...) {
 }
 
 
-validate_shared_resource <- function(args) {
+validate_shared_resource <- function(args, call) {
   if (length(args) == 0) {
-    stop("orderly_shared_resource requires at least one argument")
+    cli::cli_abort("'orderly_shared_resource' requires at least one argument",
+                   call = call)
   }
   assert_named(args, unique = TRUE)
   is_invalid <- !vlapply(args, function(x) is.character(x) && length(x) == 1)
   if (any(is_invalid)) {
-    stop(sprintf("Invalid shared resource %s: entries must be strings",
-                 paste(squote(names(args)[is_invalid]), collapse = ", ")))
+    cli::cli_abort(
+      sprintf(
+        "Invalid shared resource %s: entries must be strings",
+        paste(squote(names(args)[is_invalid]), collapse = ", ")),
+      call = call)
   }
   list_to_character(args)
 }
@@ -421,8 +426,11 @@ get_active_packet <- function() {
 }
 
 
-prevent_multiple_calls <- function(packet, name) {
+prevent_multiple_calls <- function(packet, name, call) {
   if (!is.null(packet$orderly2[[name]])) {
-    stop(sprintf("Only one call to 'orderly2::orderly_%s' is allowed", name))
+    cli::cli_abort(
+      c("Only one call to 'orderly2::orderly_{name}' is allowed",
+        i = "You have already called this function earlier in your orderly.R"),
+      call = call)
   }
 }

R/outpack_metadata.R

@@ -69,7 +69,7 @@ outpack_metadata_create <- function(path, name, id, time, files,
   time$end <- scalar(time_to_num(time$end))
 
   if (!is.null(parameters)) {
-    validate_parameters(parameters)
+    validate_parameters(parameters, NULL)
     parameters <- lapply(parameters, scalar)
   }
 

R/outpack_misc.R

@@ -64,17 +64,13 @@ find_all_dependencies <- function(id, metadata) {
 }
 
 
-validate_parameters <- function(parameters) {
+validate_parameters <- function(parameters, call) {
   if (is.null(parameters) || length(parameters) == 0) {
     return()
   }
   assert_is(parameters, "list")
   assert_named(parameters, unique = TRUE)
-  ok <- vlapply(parameters, is_simple_scalar_atomic)
-  if (!all(ok)) {
-    stop(sprintf("All parameters must be scalar atomics: error for %s",
-                 paste(squote(names(parameters)[!ok]), collapse = ", ")))
-  }
+  check_parameter_values(parameters, FALSE, call)
 }
 
 

R/outpack_packet.R

@@ -27,7 +27,7 @@ outpack_packet_start <- function(path, name, parameters = NULL, id = NULL,
 
   assert_scalar_character(name)
   assert_is_directory(path)
-  validate_parameters(parameters)
+  validate_parameters(parameters, NULL)
 
   if (is.null(id)) {
     id <- outpack_id()

R/query_search.R

@@ -36,6 +36,7 @@ orderly_search <- function(..., parameters = NULL, envir = parent.frame(),
   root <- root_open(root, locate = TRUE, require_orderly = FALSE)
   query <- as_orderly_query(...)
   options <- as_orderly_search_options(options)
+  validate_parameters(parameters, environment())
   orderly_query_eval(query, parameters, envir, options, root)
 }
 
@@ -126,7 +127,6 @@ orderly_query_eval <- function(query, parameters, envir, options, root) {
   assert_is(query, "orderly_query")
   assert_is(options, "orderly_search_options")
   assert_is(root, "outpack_root")
-  validate_parameters(parameters)
   assert_is(envir, "environment")
   ## It's simple enough here to pre-compare the provided parameters
   ## with query$info$parameters, but we already have nicer error

R/root.R

@@ -186,7 +186,7 @@ root_open <- function(path, locate, require_orderly = FALSE, call = NULL) {
   root <- outpack_root$new(path_open)
 
   if (has_orderly) {
-    root$config$orderly <- orderly_config_read(root$path)
+    root$config$orderly <- orderly_config_read(root$path, call)
   } else if (require_orderly) {
     cli::cli_abort(
       c("Did not find 'orderly_config.yml' in '{path}'",

R/run.R

@@ -136,8 +136,7 @@ orderly_run <- function(name, parameters = NULL, envir = NULL, echo = TRUE,
 
   src <- file.path(root$path, "src", name)
   dat <- orderly_read(src)
-  parameters <- check_parameters(parameters, dat$parameters,
-                                 environment())
+  parameters <- check_parameters(parameters, dat$parameters, environment())
   orderly_validate(dat, src)
 
   id <- outpack_id()
@@ -205,7 +204,7 @@ orderly_run <- function(name, parameters = NULL, envir = NULL, echo = TRUE,
   }
 
   if (success) {
-    orderly_packet_cleanup_success(p)
+    orderly_packet_cleanup_success(p, environment())
   } else if (is.null(local$error)) {
     detail <- info_end$message
     cli::cli_abort(
@@ -255,15 +254,16 @@ custom_metadata <- function(dat) {
 }
 
 
-check_produced_artefacts <- function(path, artefacts) {
+check_produced_artefacts <- function(path, artefacts, call) {
   if (is.null(artefacts)) {
     return()
   }
   expected <- unlist(lapply(artefacts, "[[", "files"), FALSE, FALSE)
   found <- file_exists(expected, workdir = path)
   if (any(!found)) {
-    stop("Script did not produce expected artefacts: ",
-         paste(squote(expected[!found]), collapse = ", "))
+    cli::cli_abort(c("Script did not produce expected artefacts:",
+                     set_names(expected[!found], rep("*", sum(!found)))),
+                   call = call)
   }
 
   for (i in seq_along(artefacts)) {
@@ -321,7 +321,7 @@ check_parameters <- function(given, spec, call) {
     return(NULL)
   }
 
-  check_parameter_values(given, FALSE)
+  check_parameter_values(given, FALSE, call)
 
   use_default <- setdiff(names(spec), names(given))
   if (length(use_default) > 0) {
@@ -331,29 +331,38 @@ check_parameters <- function(given, spec, call) {
 }
 
 
-check_parameter_values <- function(given, defaults) {
-  name <- if (defaults) "parameter defaults" else "parameters"
-  if (defaults) {
+check_parameter_values <- function(given, is_defaults, call) {
+  if (is_defaults) {
     given <- given[!vlapply(given, is.null)]
   }
 
   nonscalar <- lengths(given) != 1
-  if (any(nonscalar)) {
-    stop(sprintf(
-      "Invalid %s: %s - must be scalar",
-      name, paste(squote(names(nonscalar[nonscalar])), collapse = ", ")))
-  }
+  too_complex <- !vlapply(given, function(x) all(is_simple_atomic(x)))
+  err <- nonscalar | too_complex
 
-  err <- !vlapply(given, is_simple_atomic)
   if (any(err)) {
-    stop(sprintf(
-      "Invalid %s: %s - must be character, numeric or logical",
-      name, paste(squote((names(err[err]))), collapse = ", ")))
+    name <- if (is_defaults) "default" else "value"
+    title <- "Invalid parameter {name}{cli::qty(sum(err))}{?s}"
+    if (any(nonscalar)) {
+      msg_nonscalar <- c(
+        "x" = "Values must be scalar, but were not for:",
+        set_names(names(given)[nonscalar], rep("*", sum(nonscalar))))
+    } else {
+      msg_nonscalar <- NULL
+    }
+    if (any(too_complex)) {
+      msg_too_complex <- c(
+        "x" = "Values must be character, numeric or boolean, but were not for:",
+        set_names(names(given)[too_complex], rep("*", sum(too_complex))))
+    } else {
+      msg_too_complex <- NULL
+    }
+    cli::cli_abort(c(title, msg_nonscalar, msg_too_complex), call = call)
   }
 }
 
 
-check_parameters_interactive <- function(envir, spec) {
+check_parameters_interactive <- function(envir, spec, call) {
   if (length(spec) == 0) {
     return()
   }
@@ -379,7 +388,7 @@ check_parameters_interactive <- function(envir, spec) {
   ## that we're running in a pecular mode so the value might just have
   ## been overwritten
   found <- set_names(lapply(names(spec), function(v) envir[[v]]), names(spec))
-  check_parameter_values(found[!vlapply(found, is.null)], FALSE)
+  check_parameter_values(found[!vlapply(found, is.null)], FALSE, call)
   invisible(found)
 }
 
@@ -440,11 +449,12 @@ copy_resources_implicit <- function(src, dst, resources, artefacts) {
 
 
 ## All the cleanup bits for the happy exit (where we do the validation etc)
-orderly_packet_cleanup_success <- function(p) {
+orderly_packet_cleanup_success <- function(p, call = NULL) {
   path <- p$path
 
   plugin_run_cleanup(path, p$orderly2$config$plugins)
-  p$orderly2$artefacts <- check_produced_artefacts(path, p$orderly2$artefacts)
+  p$orderly2$artefacts <- check_produced_artefacts(path, p$orderly2$artefacts,
+                                                   call)
   if (p$orderly2$strict$enabled) {
     check_files_strict(path, p$files, p$orderly2$artefacts)
   } else {

tests/testthat/test-config.R

@@ -17,17 +17,21 @@ test_that("Can read an orderly environment file", {
 test_that("environment files must be really simple", {
   path <- test_prepare_orderly_example("explicit")
   writeLines("A: value1\nB: [1, 2]", file.path(path, "orderly_envir.yml"))
-  expect_error(
+  err <- expect_error(
     orderly_envir_read(path),
-    "Expected all elements of orderly_envir.yml to be scalar (check 'B')",
+    "All elements of 'orderly_envir.yml' must be scalar",
     fixed = TRUE)
+  expect_equal(err$body[1],
+               c(x = "Expected 'B' to be scalar, but had length 2"))
+  expect_match(err$body[[2]],
+               "^Working directory was '.+'$")
 })
 
 
 test_that("can validate minimum required version", {
   expect_error(
     orderly_config_validate_minimum_orderly_version("1.4.5", "orderly.yml"),
-    "Migrate from version 1, see docs that we need to write still...",
+    "Detected old orderly version, you need to migrate to orderly2",
     fixed = TRUE)
   expect_error(
     orderly_config_validate_minimum_orderly_version("99.0.0", "orderly.yml"),