Merge pull request #163 from mrc-ide/mrc-5130

Optional verbose output for orderly_location_list

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: orderly2
 Title: Orderly Next Generation
-Version: 1.99.23
+Version: 1.99.24
 Authors@R: c(person("Rich", "FitzJohn", role = c("aut", "cre"),
                     email = "[email protected]"),
              person("Robert", "Ashton", role = "aut"),
@@ -11,7 +11,7 @@ Description: Reimplementation of orderly based on outpack.
 License: MIT + file LICENSE
 Encoding: UTF-8
 Roxygen: list(markdown = TRUE)
-RoxygenNote: 7.3.1
+RoxygenNote: 7.3.2
 URL: https://github.com/mrc-ide/orderly2
 BugReports: https://github.com/mrc-ide/orderly2/issues
 Imports:

R/location.R

@@ -197,24 +197,39 @@ orderly_location_remove <- function(name, root = NULL, locate = TRUE) {
 }
 
 
-##' List known locations.
+##' List known locations.  The special name `local` will always be
+##' present within the output from this function (this is packets
+##' known at the current root), though you will typically be
+##' interested in *other* locations.
 ##'
 ##' @title List known pack locations
 ##'
 ##' @inheritParams orderly_metadata
 ##'
-##' @return A character vector of location names. The special name
-##'   `local` will always be present.
+##' @param verbose Logical, indicating if we should return a
+##'   data.frame that includes more information about the location.
+##'
+##' @return Depending on the value of `verbose`:
+##'
+##' * `verbose = FALSE`: A character vector of location names.  This is the
+##'   default behaviour.
+##' * `verbose = TRUE`: A data.frame with columns `name`, `type` and
+##'   `args`.  The `args` column is a list column, with each element
+##'   being the key-value pair arguments to the location.
 ##'
 ##' @seealso [orderly2::orderly_location_pull_metadata], which can
 ##'   update your outpack index with metadata from any of the
 ##'   locations listed here.
 ##'
 ##' @export
-orderly_location_list <- function(root = NULL, locate = TRUE) {
+orderly_location_list <- function(verbose = FALSE, root = NULL, locate = TRUE) {
   root <- root_open(root, locate = locate, require_orderly = FALSE,
                     call = environment())
-  root$config$location$name
+  if (verbose) {
+    root$config$location
+  } else {
+    root$config$location$name
+  }
 }
 
 
@@ -567,10 +582,10 @@ location_resolve_valid <- function(location, root, include_local,
                                    include_orphan, allow_no_locations,
                                    call = NULL) {
   if (is.null(location)) {
-    location <- orderly_location_list(root)
+    location <- orderly_location_list(root = root)
   } else if (is.character(location)) {
-    valid <- orderly_location_list(root)
-    err <- setdiff(location, orderly_location_list(root))
+    valid <- orderly_location_list(root = root)
+    err <- setdiff(location, orderly_location_list(root = root))
     if (length(err) > 0) {
       cli::cli_abort(c("Unknown location{?s}: {squote(err)}",
                        i = "Valid location{?s} are: {squote(valid)}"),
@@ -783,7 +798,7 @@ location_check_new_name <- function(root, name, call) {
 
 location_check_exists <- function(root, name, call) {
   if (!location_exists(root, name)) {
-    valid <- orderly_location_list(root)
+    valid <- orderly_location_list(root = root)
     cli::cli_abort(c("No location with name '{name}' exists",
                      i = "Possible location{?s} are: {squote(valid)}"),
                    call = call)
@@ -792,7 +807,7 @@ location_check_exists <- function(root, name, call) {
 
 
 location_exists <- function(root, name) {
-  name %in% orderly_location_list(root)
+  name %in% orderly_location_list(root = root)
 }
 
 

tests/testthat/test-location.R

@@ -1,6 +1,11 @@
 test_that("No locations except local by default", {
   root <- create_temporary_root()
   expect_equal(orderly_location_list(root = root), "local")
+  expect_equal(
+    orderly_location_list(TRUE, root = root),
+    data_frame(name = "local",
+               type = "local",
+               args = I(list(set_names(list(), character())))))
 })
 
 
@@ -15,6 +20,13 @@ test_that("Can add a location", {
 
   orderly_location_add("c", "path", list(path = root$c$path), root = root$a)
   expect_setequal(orderly_location_list(root = root$a), c("local", "b", "c"))
+
+  res <- orderly_location_list(verbose = TRUE, root = root$a)
+  expect_equal(res$name, c("local", "b", "c"))
+  expect_equal(res$type, c("local", "path", "path"))
+  expect_equal(res$args, I(list(set_names(list(), character()),
+                                list(path = root$b$path),
+                                list(path = root$c$path))))
 })
 
 

tests/testthat/test-outpack-root.R

@@ -11,7 +11,7 @@ test_that("can create new root", {
                        require_complete_tree = FALSE,
                        hash_algorithm = "sha256"))
   expect_false(file.exists(file.path(path, ".outpack", "files")))
-  expect_equal(orderly_location_list(root), "local")
+  expect_equal(orderly_location_list(root = root), "local")
 })