Skip to content

Commit

Permalink
Explicit arguments to orderly_search
Browse files Browse the repository at this point in the history
  • Loading branch information
richfitz committed Oct 18, 2024
1 parent c6c3c15 commit c767d16
Show file tree
Hide file tree
Showing 9 changed files with 76 additions and 45 deletions.
9 changes: 5 additions & 4 deletions R/location.R
Original file line number Diff line number Diff line change
Expand Up @@ -349,10 +349,11 @@ orderly_location_pull_packet <- function(expr,
if (expr_is_literal_id(expr, name)) {
ids <- expr
} else {
## TODO: we may drop options here
ids <- orderly_search(expr, name = name,
options = options,
# location = location, pull_metadata = pull_metadata,
ids <- orderly_search(expr,
name = name,
location = options$location,
allow_remote = options$allow_remote,
pull_metadata = options$pull_metadata,
root = root)
}

Expand Down
10 changes: 6 additions & 4 deletions R/outpack_helpers.R
Original file line number Diff line number Diff line change
Expand Up @@ -105,10 +105,12 @@ orderly_copy_files <- function(expr, files, dest, overwrite = TRUE,
}
} else {
## TODO: we may drop options here
id <- orderly_search(expr, name = name,
options = options,
parameters = parameters, # TODO, bind these earlier?
# location = location, pull_metadata = pull_metadata,
id <- orderly_search(expr,
name = name,
parameters = parameters,
location = options$location,
allow_remote = options$allow_remote,
pull_metadata = options$pull_metadata,
root = root)
if (length(id) > 1) {
cli::cli_abort(
Expand Down
4 changes: 3 additions & 1 deletion R/outpack_packet.R
Original file line number Diff line number Diff line change
Expand Up @@ -174,7 +174,9 @@ outpack_packet_use_dependency <- function(packet, query, files,
id <- orderly_search(query,
parameters = packet$parameters,
envir = envir,
options = search_options,
location = search_options$location,
allow_remote = search_options$allow_remote,
pull_metadata = search_options$pull_metadata,
root = packet$root)
if (is.na(id)) {
explanation <- orderly_query_explain(
Expand Down
9 changes: 5 additions & 4 deletions R/outpack_tools.R
Original file line number Diff line number Diff line change
Expand Up @@ -204,10 +204,11 @@ orderly_metadata_extract <- function(expr = NULL, name = NULL, location = NULL,
if (expr_is_literal_id(expr, name)) {
ids <- expr
} else {
## TODO: we may drop options here
ids <- orderly_search(expr, name = name,
options = options,
# location = location, pull_metadata = pull_metadata,
ids <- orderly_search(expr,
name = name,
location = options$location,
allow_remote = options$allow_remote,
pull_metadata = options$pull_metadata,
root = root)
}
extract <- parse_extract(extract, environment())
Expand Down
14 changes: 11 additions & 3 deletions R/query_explain.R
Original file line number Diff line number Diff line change
Expand Up @@ -27,7 +27,10 @@ orderly_query_explain <- function(expr, name = NULL, scope = NULL,
allow_remote = allow_remote,
pull_metadata = pull_metadata)
found <- orderly_search(query, parameters = parameters, envir = envir,
options = options, root = root)
location = options$location,
allow_remote = options$allow_remote,
pull_metadata = options$pull_metadata,
root = root)
query_simplified <- query_simplify(query)
ret <- list(found = found,
n = length(stats::na.omit(found)), # latest() returns NA
Expand All @@ -36,8 +39,13 @@ orderly_query_explain <- function(expr, name = NULL, scope = NULL,

for (name in names(query_simplified$parts)) {
expr <- query_simplified$parts[[name]]
found <- orderly_search(expr, parameters = parameters, envir = envir,
options = options, root = root)
found <- orderly_search(expr,
parameters = parameters,
envir = envir,
location = options$location,
allow_remote = options$allow_remote,
pull_metadata = FALSE, # not again.
root = root)
ret$parts[[name]] <- list(
name = name,
str = deparse_query(expr, NULL, NULL),
Expand Down
13 changes: 6 additions & 7 deletions R/query_search.R
Original file line number Diff line number Diff line change
Expand Up @@ -15,13 +15,9 @@
##' use the calling environment, but you can explicitly pass this in
##' if you want to control where this lookup happens.
##'
##' @param options Optionally, a [orderly2::orderly_search_options]
##' object for controlling how the search is performed, and which
##' packets should be considered in scope. If not provided, default
##' options are used (i.e., `orderly2::orderly_search_options()`)
##'
##' @inheritParams orderly_metadata
##' @inheritParams orderly_query
##' @inheritParams orderly_search_options
##'
##' @return A character vector of matching ids. In the case of no
##' match from a query returning a single value (e.g., `latest(...)`
Expand All @@ -31,10 +27,13 @@
##' @export
orderly_search <- function(expr, name = NULL, scope = NULL, subquery = NULL,
parameters = NULL, envir = parent.frame(),
options = NULL, root = NULL) {
location = NULL, allow_remote = NULL,
pull_metadata = FALSE, root = NULL) {
root <- root_open(root, require_orderly = FALSE)
query <- as_orderly_query(expr, name, scope, subquery)
options <- as_orderly_search_options(options)
options <- orderly_search_options(location = location,
allow_remote = allow_remote,
pull_metadata = pull_metadata)
validate_parameters(parameters, environment())
orderly_query_eval(query, parameters, envir, options, root,
call = environment())
Expand Down
7 changes: 6 additions & 1 deletion R/validate.R
Original file line number Diff line number Diff line change
Expand Up @@ -55,7 +55,12 @@ orderly_validate_archive <- function(expr = NULL, name = NULL,
} else {
## TODO: we may drop options here
options <- orderly_search_options(location = "local", allow_remote = FALSE)
ids <- orderly_search(expr, name = name, options = options, root = root)
ids <- orderly_search(expr,
name = name,
location = options$location,
allow_remote = options$allow_remote,
pull_metadata = options$pull_metadata,
root = root)
}

cache <- new.env(parent = emptyenv())
Expand Down
28 changes: 23 additions & 5 deletions man/orderly_search.Rd

Some generated files are not rendered by default. Learn more about how customized files appear on GitHub.

27 changes: 11 additions & 16 deletions tests/testthat/test-query-search.R
Original file line number Diff line number Diff line change
Expand Up @@ -248,31 +248,26 @@ test_that("Can filter query to packets that are locally available (unpacked)", {
}
orderly_location_pull_metadata(root = root$a)

options_local <- orderly_search_options(location = c("x", "y"),
allow_remote = FALSE)
options_remote <- orderly_search_options(location = c("x", "y"),
allow_remote = TRUE)

expect_equal(
orderly_search(quote(name == "data"), options = options_remote,
orderly_search(quote(name == "data"), location = c("x", "y"),
root = root$a),
c(ids$x, ids$y))
expect_equal(
orderly_search(quote(name == "data"), options = options_local,
root = root$a),
orderly_search(quote(name == "data"), location = c("x", "y"),
allow_remote = FALSE, root = root$a),
character())

for (i in ids$x) {
suppressMessages(orderly_location_pull_packet(i, root = root$a))
}

expect_equal(
orderly_search(quote(name == "data"), options = options_remote,
orderly_search(quote(name == "data"), location = c("x", "y"),
root = root$a),
c(ids$x, ids$y))
expect_equal(
orderly_search(quote(name == "data"), options = options_local,
root = root$a),
orderly_search(quote(name == "data"), location = c("x", "y"),
allow_remote = FALSE, root = root$a),
ids$x)
})

Expand All @@ -294,12 +289,12 @@ test_that("scope and allow_local can be used together to filter query", {
options_remote <- orderly_search_options(allow_remote = TRUE)

expect_equal(
orderly_search(quote(latest(parameter:p == 1)), options = options_remote,
orderly_search(quote(latest(parameter:p == 1)), allow_remote = TRUE,
scope = quote(name == "x"),
root = root$dst),
x2)
expect_equal(
orderly_search(quote(latest(parameter:p == 1)), options = options_local,
orderly_search(quote(latest(parameter:p == 1)), allow_remote = FALSE,,
scope = quote(name == "x"),
root = root$dst),
NA_character_)
Expand All @@ -309,12 +304,12 @@ test_that("scope and allow_local can be used together to filter query", {
}

expect_equal(
orderly_search(quote(latest(parameter:p == 1)), options = options_remote,
orderly_search(quote(latest(parameter:p == 1)), allow_remote = TRUE,
scope = quote(name == "x"),
root = root$dst),
x2)
expect_equal(
orderly_search(quote(latest(parameter:p == 1)), options = options_local,
orderly_search(quote(latest(parameter:p == 1)), allow_remote = FALSE,
scope = quote(name == "x"),
root = root$dst),
x1)
Expand Down Expand Up @@ -904,7 +899,7 @@ test_that("allow search before query", {
character(0))
expect_equal(
orderly_search(quote(name == "data"), root = root$a,
options = list(pull_metadata = TRUE, allow_remote = TRUE)),
pull_metadata = TRUE, allow_remote = TRUE),
ids)
expect_setequal(names(root$a$index$data()$metadata), ids)
})
Expand Down

0 comments on commit c767d16

Please sign in to comment.