diff --git a/DESCRIPTION b/DESCRIPTION index fa203067..f31a2101 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,6 +1,6 @@ Package: orderly2 Title: Orderly Next Generation -Version: 1.99.11 +Version: 1.99.12 Authors@R: c(person("Rich", "FitzJohn", role = c("aut", "cre"), email = "rich.fitzjohn@gmail.com"), person("Robert", "Ashton", role = "aut"), diff --git a/R/cleanup.R b/R/cleanup.R index 60f2db9e..932d49b2 100644 --- a/R/cleanup.R +++ b/R/cleanup.R @@ -48,7 +48,7 @@ ##' # We simulate running a packet interactively by using 'source'; ##' # you might have run this line-by-line, or with the "Source" ##' # button in Rstudio. -##' source(file.path(path, "src/data/orderly.R"), chdir = TRUE) +##' source(file.path(path, "src/data/data.R"), chdir = TRUE) ##' ##' # Having run this, the output of the report is present in the ##' # source directory: @@ -137,8 +137,9 @@ orderly_cleanup_status <- function(name = NULL, root = NULL, locate = TRUE) { nms_artefact <- unlist(lapply(info$artefacts, "[[", "files")) nms_dependency <- unlist(lapply(info$dependency, function(x) names(x$files))) nms_shared_resource <- names(info$shared_resource) + entrypoint_filename <- find_entrypoint_filename(path) - role <- cbind(orderly = files == "orderly.R", + role <- cbind(orderly = files == entrypoint_filename, resource = matches_path(files, nms_resource), shared_resource = matches_path(files, nms_shared_resource), dependency = matches_path(files, nms_dependency, FALSE), diff --git a/R/gitignore.R b/R/gitignore.R index a7bb26f4..0e5c3175 100644 --- a/R/gitignore.R +++ b/R/gitignore.R @@ -72,7 +72,7 @@ gitignore_content_root <- function(root_path) { gitignore_content_src <- function(name, root_path) { - dat <- orderly_read_r(file.path(root_path, "src", name, "orderly.R")) + dat <- orderly_read(file.path(root_path, "src", name)) ignore_deps <- unlist(lapply(dat$dependency, function(x) names(x$files))) ignore_artefacts <- unlist(lapply(dat$artefacts, "[[", "files")) diff --git a/R/metadata.R b/R/metadata.R index 3d20fa9d..f08159fd 100644 --- a/R/metadata.R +++ b/R/metadata.R @@ -47,7 +47,7 @@ static_orderly_strict_mode <- function(args) { ##' @section Behaviour in interactive sessions: ##' ##' When running interactively (i.e., via `source()` or running an -##' `orderly.R` session by copy/paste or in Rstudio), the +##' orderly file session by copy/paste or in Rstudio), the ##' `orderly_parameters()` function has different behaviour. ##' ##' First, we look in the current environment (most likely the global @@ -452,9 +452,11 @@ get_active_packet <- function() { prevent_multiple_calls <- function(packet, name, call) { if (!is.null(packet$orderly2[[name]])) { + entrypoint_filename <- find_entrypoint_filename(packet$orderly2$src) 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"), + i = paste("You have already called this function earlier", + "in your {entrypoint_filename}")), call = call) } } diff --git a/R/orderly.R b/R/orderly.R index f7275f49..3d436168 100644 --- a/R/orderly.R +++ b/R/orderly.R @@ -1,5 +1,7 @@ ##' List source reports - that is, directories within `src/` that -##' contain a file `orderly.R` +##' look suitable for running with orderly; these will be directories +##' that contain an entrypoint file - a `.R` file with the same name +##' as the directory (e.g., `src/data/data.R` corresponds to `data`). ##' ##' @title List source reports ##' @@ -21,7 +23,11 @@ orderly_list_src <- function(root = NULL, locate = TRUE) { return(character()) } pos <- fs::dir_ls(file.path(root_path, "src"), type = "directory") - basename(pos)[file_exists(file.path(pos, "orderly.R"))] + entrypoint <- vcapply(pos, function(path) { + find_entrypoint_filename(path, suppress_zero_files = TRUE, + suppress_multiple_files = TRUE) + }) + basename(pos)[!is.na(entrypoint)] } @@ -36,7 +42,7 @@ orderly_list_src <- function(root = NULL, locate = TRUE) { ##' suppresses any default content. We may support customisable ##' templates in future - let us know if this would be useful. ##' -##' @param force Create an `orderly.R` file within an existing +##' @param force Create an orderly file - `.R` within an existing ##' directory `src/`; this may be useful if you have already ##' created the directory and some files first but want help ##' creating the orderly file. @@ -49,9 +55,13 @@ orderly_new <- function(name, template = NULL, force = FALSE, root = NULL, locate = TRUE) { root <- root_open(root, locate, require_orderly = TRUE, call = environment()) dest <- file.path(root$path, "src", name) + existing_entrypoint_filename <- find_entrypoint_filename( + dest, suppress_zero_files = TRUE + ) + new_report_filename <- sprintf("%s.R", name) - if (file.exists(file.path(dest, "orderly.R"))) { - cli::cli_abort("'src/{name}/orderly.R' already exists") + if (!is.na(existing_entrypoint_filename)) { + cli::cli_abort("'src/{name}/{existing_entrypoint_filename}' already exists") } if (file.exists(dest) && !fs::is_dir(dest)) { cli::cli_abort( @@ -61,8 +71,9 @@ orderly_new <- function(name, template = NULL, force = FALSE, if (length(dir(dest, all.files = TRUE, no.. = TRUE)) > 0 && !force) { cli::cli_abort( c("'src/{name}/' already exists and contains files", - i = paste("If you want to add an orderly.R to this directory,", - "rerun {.code orderly_new()} with {.code force = TRUE}"))) + i = paste("If you want to add a {new_report_filename} to this", + "directory, rerun {.code orderly_new()} with", + "{.code force = TRUE}"))) } if (is.null(template)) { @@ -74,6 +85,6 @@ orderly_new <- function(name, template = NULL, force = FALSE, } fs::dir_create(dest) - writeLines(contents, file.path(dest, "orderly.R")) - cli::cli_alert_success("Created 'src/{name}/orderly.R'") + writeLines(contents, file.path(dest, new_report_filename)) + cli::cli_alert_success("Created 'src/{name}/{new_report_filename}'") } diff --git a/R/plugin.R b/R/plugin.R index 160dc406..b0e9ec71 100644 --- a/R/plugin.R +++ b/R/plugin.R @@ -1,6 +1,6 @@ ##' Create an orderly plugin. A plugin is typically defined by a ##' package and is used to extend orderly by enabling new -##' functionality, declared in `orderly_config.yml` and `orderly.R` +##' functionality, declared in `orderly_config.yml` and your orderly file, ##' and affecting the running of reports primarily by creating new ##' objects in the report environment. This system is discussed in ##' more detail in `vignette("plugins")`, but will be expanded (likely diff --git a/R/read.R b/R/read.R index 99fe674d..3faa6edf 100644 --- a/R/read.R +++ b/R/read.R @@ -1,11 +1,10 @@ orderly_read <- function(path, call = NULL) { - assert_file_exists_relative("orderly.R", name = "Orderly file", - workdir = path, call = call) - orderly_read_r(file.path(path, "orderly.R")) + entrypoint_filename <- find_entrypoint_filename(path) + orderly_read_r(file.path(path, entrypoint_filename), entrypoint_filename) } -orderly_read_r <- function(path) { +orderly_read_r <- function(path, entrypoint_filename) { exprs <- parse(file = path) inputs <- list() @@ -51,7 +50,7 @@ orderly_read_r <- function(path) { ## Rename to make things easier below: names(dat) <- sub("^orderly_", "", names(dat)) - ret <- list() + ret <- list(entrypoint_filename = entrypoint_filename) if (length(dat$strict_mode) > 0) { ret$strict <- dat$strict_mode[[1]] } else { @@ -72,11 +71,12 @@ orderly_read_r <- function(path) { ## TODO: probably some santisiation required here: ## ## * what do we do with directories here? - ## * discourage people from listing orderly.R + ## * discourage people from listing orderly files ## * discourage duplicates + if (length(dat$resource) > 0) { ret$resources <- setdiff(unique(unlist(dat$resource, TRUE, FALSE)), - "orderly.R") + entrypoint_filename) } if (length(dat$artefact) > 0) { ret$artefacts <- dat$artefact diff --git a/R/run.R b/R/run.R index 098296c0..0fb4921a 100644 --- a/R/run.R +++ b/R/run.R @@ -177,6 +177,7 @@ orderly_run <- function(name, parameters = NULL, envir = NULL, echo = TRUE, src <- file.path(root_src, "src", name) dat <- orderly_read(src, environment()) + entrypoint_filename <- dat$entrypoint_filename parameters <- check_parameters(parameters, dat$parameters, environment()) orderly_validate(dat, src) @@ -194,14 +195,14 @@ orderly_run <- function(name, parameters = NULL, envir = NULL, echo = TRUE, if (dat$strict$enabled) { inputs_info <- NULL - fs::file_copy(file.path(src, "orderly.R"), path) + fs::file_copy(file.path(src, entrypoint_filename), path) } else { inputs_info <- copy_resources_implicit(src, path, dat$resources, dat$artefacts) } p <- outpack_packet_start(path, name, parameters = parameters, id = id, root = root) - outpack_packet_file_mark(p, "orderly.R", "immutable") + outpack_packet_file_mark(p, entrypoint_filename, "immutable") p$orderly2 <- list(config = root$config$orderly, envir = envir, src = src, root = root_src, strict = dat$strict, inputs_info = inputs_info, search_options = search_options) @@ -216,7 +217,7 @@ orderly_run <- function(name, parameters = NULL, envir = NULL, echo = TRUE, local <- new.env(parent = emptyenv()) local$warnings <- collector() res <- rlang::try_fetch( - withr::with_dir(path, source_echo("orderly.R", envir, echo)), + withr::with_dir(path, source_echo(entrypoint_filename, envir, echo)), warning = function(e) { local$warnings$add(e) rlang::zap() @@ -233,9 +234,9 @@ orderly_run <- function(name, parameters = NULL, envir = NULL, echo = TRUE, success <- is.null(local$error) && info_end$success if (success) { - cli::cli_alert_success("Finished running {.file orderly.R}") + cli::cli_alert_success("Finished running {.file {entrypoint_filename}}") } else { - cli::cli_alert_danger("Error running {.file orderly.R}") + cli::cli_alert_danger("Error running {.file {entrypoint_filename}}") } if (length(local$warnings$get()) > 0) { @@ -265,9 +266,10 @@ orderly_run <- function(name, parameters = NULL, envir = NULL, echo = TRUE, custom_metadata <- function(dat) { + entrypoint_filename <- find_entrypoint_filename(dat$src) shared <- dat$shared_resources %||% list() role <- data_frame( - path = c("orderly.R", dat$resources, shared$here), + path = c(entrypoint_filename, dat$resources, shared$here), role = c("orderly", rep_along("resource", dat$resources), rep_along("shared", shared$here))) @@ -517,24 +519,27 @@ orderly_packet_add_metadata <- function(p) { validate_orderly_directory <- function(name, root_path, call) { assert_scalar_character(name, call = call) - re <- "^(./)*(src/)?(.+?)/?$" name <- sub(re, "\\3", name) - if (!file_exists(file.path(root_path, "src", name, "orderly.R"))) { - src <- file.path(root_path, "src", name) - err <- sprintf("Did not find orderly report '%s'", name) - if (!file_exists(src)) { - detail <- sprintf("The path 'src/%s' does not exist", name) - } else if (is_directory(src)) { - detail <- sprintf( - "The path 'src/%s' exists but does not contain 'orderly.R'", - name) - } else { - detail <- sprintf( - "The path 'src/%s' exists but is not a directory", - name) - } - err <- c(err, x = detail) + src <- file.path(root_path, "src", name) + + is_error <- FALSE + if (!file_exists(src)) { + is_error <- TRUE + detail <- sprintf("The path 'src/%s' does not exist", name) + } else if (!is_directory(src)) { + is_error <- TRUE + detail <- sprintf( + "The path 'src/%s' exists but is not a directory", + name + ) + } + + if (is_error) { + err <- c( + sprintf("Did not find orderly report '%s'", name), + x = detail + ) near <- near_match(name, orderly_list_src(root_path, FALSE)) if (length(near) > 0) { hint <- sprintf("Did you mean %s", @@ -546,6 +551,10 @@ validate_orderly_directory <- function(name, root_path, call) { cli::cli_abort(err, call = call) } + # Just being called for the deprecation warning + # Should be removed once we deprecate the name + find_entrypoint_filename(file.path(root_path, "src", name)) + name } diff --git a/R/util_assert.R b/R/util_assert.R index ca31d306..c888e19a 100644 --- a/R/util_assert.R +++ b/R/util_assert.R @@ -80,6 +80,36 @@ assert_file_exists <- function(files, name = "File", call = NULL, arg = NULL) { } +find_entrypoint_filename <- function(src, suppress_zero_files = FALSE, + suppress_multiple_files = FALSE) { + reportname <- basename(src) + names <- c(sprintf("%s.R", reportname), "orderly.R") + files_exist <- file.exists(file.path(src, names)) + n_found <- sum(files_exist) + if (n_found > 1 && !suppress_multiple_files) { + cli::cli_abort( + paste("Please only create {names[[1]]} file, orderly.R", + "has been deprecated") + ) + } + if (n_found == 0 && !suppress_zero_files) { + cli::cli_abort( + "Please create {names[[1]]} file" + ) + } + if (files_exist[[2]]) { + cli::cli_warn( + paste("Naming convention orderly.R will be deprecated", + "soon. Please change orderly file name to", + ".R"), + .frequency = "regularly", + .frequency_id = "deprecate_orderly_file_name" + ) + } + if (n_found == 1) names[files_exist] else NA_character_ +} + + assert_file_exists_relative <- function(files, workdir, name, call = NULL) { assert_relative_path(files, name, workdir, call) diff --git a/_pkgdown.yml b/_pkgdown.yml index 9711fb8d..4a9ead98 100644 --- a/_pkgdown.yml +++ b/_pkgdown.yml @@ -28,7 +28,7 @@ reference: - orderly_list_src - title: From within a running report desc: >- - These are the functions that get called from your `orderly.R` file + These are the functions that get called from your orderly file contents: - orderly_strict_mode - orderly_parameters diff --git a/inst/example/src/data/orderly.R b/inst/example/src/data/data.R similarity index 100% rename from inst/example/src/data/orderly.R rename to inst/example/src/data/data.R diff --git a/man/orderly_cleanup.Rd b/man/orderly_cleanup.Rd index fcf100a6..60312aa6 100644 --- a/man/orderly_cleanup.Rd +++ b/man/orderly_cleanup.Rd @@ -71,7 +71,7 @@ path <- orderly2::orderly_example("default") # We simulate running a packet interactively by using 'source'; # you might have run this line-by-line, or with the "Source" # button in Rstudio. -source(file.path(path, "src/data/orderly.R"), chdir = TRUE) +source(file.path(path, "src/data/data.R"), chdir = TRUE) # Having run this, the output of the report is present in the # source directory: diff --git a/man/orderly_list_src.Rd b/man/orderly_list_src.Rd index 340959ba..9ccde3b9 100644 --- a/man/orderly_list_src.Rd +++ b/man/orderly_list_src.Rd @@ -24,7 +24,9 @@ for passing to \link{orderly_run} } \description{ List source reports - that is, directories within \verb{src/} that -contain a file \code{orderly.R} +look suitable for running with orderly; these will be directories +that contain an entrypoint file - a \code{.R} file with the same name +as the directory (e.g., \code{src/data/data.R} corresponds to \code{data}). } \examples{ path <- orderly2::orderly_example("default") diff --git a/man/orderly_new.Rd b/man/orderly_new.Rd index 70061900..5cc18e1c 100644 --- a/man/orderly_new.Rd +++ b/man/orderly_new.Rd @@ -14,7 +14,7 @@ for now are \code{NULL} (uses the built-in default) and \code{FALSE} which suppresses any default content. We may support customisable templates in future - let us know if this would be useful.} -\item{force}{Create an \code{orderly.R} file within an existing +\item{force}{Create an orderly file - \verb{.R} within an existing directory \verb{src/}; this may be useful if you have already created the directory and some files first but want help creating the orderly file.} diff --git a/man/orderly_parameters.Rd b/man/orderly_parameters.Rd index e8c32b21..095f2289 100644 --- a/man/orderly_parameters.Rd +++ b/man/orderly_parameters.Rd @@ -25,7 +25,7 @@ have a default, in which case this parameter will be required. When running interactively (i.e., via \code{source()} or running an -\code{orderly.R} session by copy/paste or in Rstudio), the +orderly file session by copy/paste or in Rstudio), the \code{orderly_parameters()} function has different behaviour. First, we look in the current environment (most likely the global diff --git a/man/orderly_plugin_register.Rd b/man/orderly_plugin_register.Rd index dbb0d92a..41c44cd7 100644 --- a/man/orderly_plugin_register.Rd +++ b/man/orderly_plugin_register.Rd @@ -43,7 +43,7 @@ etc), and will make your plugin nicer to work with \code{\link[=orderly_metadata_extract]{orderly_metadata_extract()}}. This function will be given a single argument \code{data} which is the data from \code{jsonlite::fromJSON(..., simplifyVector = FALSE)} and you should -apply and required simplifications yourself, returning a +apply any required simplifications yourself, returning a modified copy of the argument.} \item{cleanup}{Optionally, a function to clean up any state that @@ -64,7 +64,7 @@ registering a plugin. \description{ Create an orderly plugin. A plugin is typically defined by a package and is used to extend orderly by enabling new -functionality, declared in \code{orderly_config.yml} and \code{orderly.R} +functionality, declared in \code{orderly_config.yml} and your orderly file, and affecting the running of reports primarily by creating new objects in the report environment. This system is discussed in more detail in \code{vignette("plugins")}, but will be expanded (likely diff --git a/tests/testthat/examples/computed-resource/orderly.R b/tests/testthat/examples/computed-resource/computed-resource.R similarity index 100% rename from tests/testthat/examples/computed-resource/orderly.R rename to tests/testthat/examples/computed-resource/computed-resource.R diff --git a/tests/testthat/examples/data/orderly.R b/tests/testthat/examples/data/data.R similarity index 100% rename from tests/testthat/examples/data/orderly.R rename to tests/testthat/examples/data/data.R diff --git a/tests/testthat/examples/depends-params/orderly.R b/tests/testthat/examples/depends-params/depends-params.R similarity index 100% rename from tests/testthat/examples/depends-params/orderly.R rename to tests/testthat/examples/depends-params/depends-params.R diff --git a/tests/testthat/examples/depends-query/orderly.R b/tests/testthat/examples/depends-query/depends-query.R similarity index 100% rename from tests/testthat/examples/depends-query/orderly.R rename to tests/testthat/examples/depends-query/depends-query.R diff --git a/tests/testthat/examples/depends/orderly.R b/tests/testthat/examples/depends/depends.R similarity index 100% rename from tests/testthat/examples/depends/orderly.R rename to tests/testthat/examples/depends/depends.R diff --git a/tests/testthat/examples/deprecated-orderly-name/orderly.R b/tests/testthat/examples/deprecated-orderly-name/orderly.R new file mode 100644 index 00000000..c7a6add5 --- /dev/null +++ b/tests/testthat/examples/deprecated-orderly-name/orderly.R @@ -0,0 +1,3 @@ +orderly2::orderly_artefact("Some data", "data.rds") +d <- data.frame(a = 1:10, x = runif(10), y = 1:10 + runif(10)) +saveRDS(d, "data.rds") diff --git a/tests/testthat/examples/description/orderly.R b/tests/testthat/examples/description/description.R similarity index 100% rename from tests/testthat/examples/description/orderly.R rename to tests/testthat/examples/description/description.R diff --git a/tests/testthat/examples/directories/orderly.R b/tests/testthat/examples/directories/directories.R similarity index 100% rename from tests/testthat/examples/directories/orderly.R rename to tests/testthat/examples/directories/directories.R diff --git a/tests/testthat/examples/explicit/orderly.R b/tests/testthat/examples/explicit/explicit.R similarity index 100% rename from tests/testthat/examples/explicit/orderly.R rename to tests/testthat/examples/explicit/explicit.R diff --git a/tests/testthat/examples/implicit/orderly.R b/tests/testthat/examples/implicit/implicit.R similarity index 100% rename from tests/testthat/examples/implicit/orderly.R rename to tests/testthat/examples/implicit/implicit.R diff --git a/tests/testthat/examples/parameters/orderly.R b/tests/testthat/examples/parameters/parameters.R similarity index 100% rename from tests/testthat/examples/parameters/orderly.R rename to tests/testthat/examples/parameters/parameters.R diff --git a/tests/testthat/examples/plugin/orderly.R b/tests/testthat/examples/plugin/plugin.R similarity index 100% rename from tests/testthat/examples/plugin/orderly.R rename to tests/testthat/examples/plugin/plugin.R diff --git a/tests/testthat/examples/programmatic-resource/orderly.R b/tests/testthat/examples/programmatic-resource/programmatic-resource.R similarity index 100% rename from tests/testthat/examples/programmatic-resource/orderly.R rename to tests/testthat/examples/programmatic-resource/programmatic-resource.R diff --git a/tests/testthat/examples/reexport/orderly.R b/tests/testthat/examples/reexport/reexport.R similarity index 100% rename from tests/testthat/examples/reexport/orderly.R rename to tests/testthat/examples/reexport/reexport.R diff --git a/tests/testthat/examples/resource-in-directory/orderly.R b/tests/testthat/examples/resource-in-directory/resource-in-directory.R similarity index 100% rename from tests/testthat/examples/resource-in-directory/orderly.R rename to tests/testthat/examples/resource-in-directory/resource-in-directory.R diff --git a/tests/testthat/examples/shared-dir/orderly.R b/tests/testthat/examples/shared-dir/shared-dir.R similarity index 100% rename from tests/testthat/examples/shared-dir/orderly.R rename to tests/testthat/examples/shared-dir/shared-dir.R diff --git a/tests/testthat/examples/shared/orderly.R b/tests/testthat/examples/shared/shared.R similarity index 100% rename from tests/testthat/examples/shared/orderly.R rename to tests/testthat/examples/shared/shared.R diff --git a/tests/testthat/examples/two-orderly-files/orderly.R b/tests/testthat/examples/two-orderly-files/orderly.R new file mode 100644 index 00000000..c7a6add5 --- /dev/null +++ b/tests/testthat/examples/two-orderly-files/orderly.R @@ -0,0 +1,3 @@ +orderly2::orderly_artefact("Some data", "data.rds") +d <- data.frame(a = 1:10, x = runif(10), y = 1:10 + runif(10)) +saveRDS(d, "data.rds") diff --git a/tests/testthat/examples/two-orderly-files/two-orderly-files.R b/tests/testthat/examples/two-orderly-files/two-orderly-files.R new file mode 100644 index 00000000..c7a6add5 --- /dev/null +++ b/tests/testthat/examples/two-orderly-files/two-orderly-files.R @@ -0,0 +1,3 @@ +orderly2::orderly_artefact("Some data", "data.rds") +d <- data.frame(a = 1:10, x = runif(10), y = 1:10 + runif(10)) +saveRDS(d, "data.rds") diff --git a/tests/testthat/test-cleanup.R b/tests/testthat/test-cleanup.R index b8a3c612..e05c4133 100644 --- a/tests/testthat/test-cleanup.R +++ b/tests/testthat/test-cleanup.R @@ -3,7 +3,7 @@ test_that("can cleanup explicit things quite well", { envir <- new.env() path_src <- file.path(path, "src", "explicit") withr::with_dir(path_src, - sys.source("orderly.R", envir)) + sys.source("explicit.R", envir)) status <- withr::with_dir(path_src, orderly_cleanup_status()) expect_s3_class(status, "orderly_cleanup_status") @@ -15,16 +15,16 @@ test_that("can cleanup explicit things quite well", { normalise_path(root_open(path, FALSE, FALSE)$path)) expect_equal(normalise_path(status$path), normalise_path(file.path(status$root, "src", status$name))) - paths <- c("data.csv", "mygraph.png", "orderly.R") + paths <- c("data.csv", "explicit.R", "mygraph.png") expect_equal(status$role, - cbind(orderly = set_names(c(FALSE, FALSE, TRUE), paths), + cbind(orderly = set_names(c(FALSE, TRUE, FALSE), paths), resource = c(TRUE, FALSE, FALSE), shared_resource = FALSE, dependency = FALSE, - artefact = c(FALSE, TRUE, FALSE))) + artefact = c(FALSE, FALSE, TRUE))) expect_equal(status$status, - cbind(source = set_names(c(TRUE, FALSE, TRUE), paths), - derived = c(FALSE, TRUE, FALSE), + cbind(source = set_names(c(TRUE, TRUE, FALSE), paths), + derived = c(FALSE, FALSE, TRUE), ignored = NA)) expect_equal(status$delete, "mygraph.png") expect_equal(status$unknown, character()) @@ -40,13 +40,13 @@ test_that("can cleanup explicit things quite well", { withr::with_dir(path_src, orderly_cleanup(dry_run = TRUE))) expect_match(res$messages, "I would delete 1 file from 'explicit':", all = FALSE) - expect_setequal(dir(path_src), c("data.csv", "orderly.R", "mygraph.png")) + expect_setequal(dir(path_src), c("data.csv", "explicit.R", "mygraph.png")) expect_equal(res$result, status) res <- testthat::evaluate_promise( withr::with_dir(path_src, orderly_cleanup())) expect_match(res$messages, "Deleting 1 file from 'explicit':", all = FALSE) - expect_setequal(dir(path_src), c("data.csv", "orderly.R")) + expect_setequal(dir(path_src), c("data.csv", "explicit.R")) expect_equal(res$result, status) }) @@ -57,7 +57,7 @@ test_that("inform when running implicitly", { envir <- new.env() path_src <- file.path(path, "src", "implicit") withr::with_dir(path_src, - sys.source("orderly.R", envir)) + sys.source("implicit.R", envir)) status <- withr::with_dir(path_src, orderly_cleanup_status()) expect_equal(status$delete, character()) @@ -126,7 +126,7 @@ test_that("can clean up unknown files if gitignored", { expect_equal(res$result, status) expect_setequal( dir(path_src, recursive = TRUE, include.dirs = TRUE), - c("a", "a/x", "data.csv", "orderly.R")) + c("a", "a/x", "data.csv", "explicit.R")) }) @@ -136,7 +136,7 @@ test_that("can clean up shared resources", { file.create(file.path(path_src, "shared_data.csv")) status <- orderly_cleanup_status("shared", root = path) - files <- c("orderly.R", "shared_data.csv") + files <- c("shared.R", "shared_data.csv") expect_setequal(rownames(status$role), files) expect_equal( status$role, @@ -160,19 +160,19 @@ test_that("can clean up dependencies", { file.create(file.path(path_src, c("input.rds", "other.rds"))) status <- orderly_cleanup_status("depends", root = path) - files <- c("input.rds", "orderly.R", "other.rds") + files <- c("depends.R", "input.rds", "other.rds") expect_setequal(rownames(status$role), files) expect_equal( status$role, - cbind(orderly = set_names(c(FALSE, TRUE, FALSE), files), + cbind(orderly = set_names(c(TRUE, FALSE, FALSE), files), resource = FALSE, shared_resource = FALSE, - dependency = c(TRUE, FALSE, FALSE), + dependency = c(FALSE, TRUE, FALSE), artefact = FALSE)) expect_equal( status$status, - cbind(source = set_names(c(FALSE, TRUE, FALSE), files), - derived = c(TRUE, FALSE, FALSE), + cbind(source = set_names(c(TRUE, FALSE, FALSE), files), + derived = c(FALSE, TRUE, FALSE), ignored = NA)) expect_equal(status$delete, "input.rds") }) @@ -183,15 +183,15 @@ test_that("can clean up directories", { envir <- new.env() path_src <- file.path(path, "src", "directories") withr::with_dir(path_src, - sys.source("orderly.R", envir)) + sys.source("directories.R", envir)) status <- orderly_cleanup_status("directories", root = path) - files <- c("data/a.csv", "data/b.csv", "orderly.R", + files <- c("data/a.csv", "data/b.csv", "directories.R", "output/a.rds", "output/b.rds") expect_equal(rownames(status$role), files) expect_equal( status$role, - cbind(orderly = set_names(files == "orderly.R", files), + cbind(orderly = set_names(files == "directories.R", files), resource = c(TRUE, TRUE, FALSE, FALSE, FALSE), shared_resource = FALSE, dependency = FALSE, @@ -207,14 +207,14 @@ test_that("can clean up directories", { expect_equal(res$result, status) expect_setequal( dir(path_src, recursive = TRUE, include.dirs = TRUE), - c("data", "data/a.csv", "data/b.csv", "orderly.R")) + c("data", "data/a.csv", "data/b.csv", "directories.R")) }) test_that("Don't call cleanup on an active packet", { path <- test_prepare_orderly_example("data") path_src <- file.path(path, "src", "data") - append_lines(file.path(path_src, "orderly.R"), + append_lines(file.path(path_src, "data.R"), "orderly2::orderly_cleanup_status()") expect_error( orderly_run_quietly("data", root = path), diff --git a/tests/testthat/test-interactive.R b/tests/testthat/test-interactive.R index 96315a70..b3ca67bd 100644 --- a/tests/testthat/test-interactive.R +++ b/tests/testthat/test-interactive.R @@ -22,7 +22,7 @@ test_that("suggests changing working directory", { e <- expect_error(detect_orderly_interactive_path( path = file.path(root, "src"), - editor_path = file.path(root, "src", "implicit", "orderly.R")), + editor_path = file.path(root, "src", "implicit", "implicit.R")), "Working directory .* is not a valid orderly report") expect_match(e$body[[1]], paste( "Use `setwd(.*)` to set the working directory", @@ -30,7 +30,7 @@ test_that("suggests changing working directory", { w <- expect_warning(detect_orderly_interactive_path( path = file.path(root, "src", "explicit"), - editor_path = file.path(root, "src", "implicit", "orderly.R")), + editor_path = file.path(root, "src", "implicit", "implicit.R")), "Working directory .* does not match the report currently open in RStudio") expect_match(w$body[[1]], "Use `setwd(.*)` to switch working directories") }) @@ -41,7 +41,7 @@ test_that("does not unnecessarily suggest changing working directory", { # Editor path is already the current working directory expect_no_warning(detect_orderly_interactive_path( path = file.path(root, "src", "explicit"), - editor_path = file.path(root, "src", "explicit", "orderly.R") + editor_path = file.path(root, "src", "explicit", "explicit.R") )) # Editor path is not an orderly report diff --git a/tests/testthat/test-orderly.R b/tests/testthat/test-orderly.R index a05fc254..eeb7337a 100644 --- a/tests/testthat/test-orderly.R +++ b/tests/testthat/test-orderly.R @@ -13,10 +13,10 @@ test_that("find expected candidates", { }) -test_that("ignore paths without orderly.R", { +test_that("ignore paths without orderly file", { v <- c("data", "depends", "depends-params", "description") path <- test_prepare_orderly_example(v) - unlink(file.path(path, "src", v[1], "orderly.R")) + unlink(file.path(path, "src", v[1], "data.R")) expect_equal(orderly_list_src(path), v[-1]) }) @@ -35,8 +35,8 @@ test_that("can create empty orderly report", { path <- test_prepare_orderly_example(character()) expect_message( orderly_new("foo", root = path), - "Created 'src/foo/orderly.R'") - path_orderly <- file.path(path, "src", "foo", "orderly.R") + "Created 'src/foo/foo.R'") + path_orderly <- file.path(path, "src", "foo", "foo.R") expect_true(file.exists(path_orderly)) txt <- readLines(path_orderly) expect_match(txt[[1]], "This is an orderly script") @@ -47,19 +47,27 @@ test_that("can create a totally blank orderly report", { path <- test_prepare_orderly_example(character()) expect_message( orderly_new("foo", template = FALSE, root = path), - "Created 'src/foo/orderly.R'") - path_orderly <- file.path(path, "src", "foo", "orderly.R") + "Created 'src/foo/foo.R'") + path_orderly <- file.path(path, "src", "foo", "foo.R") expect_true(file.exists(path_orderly)) expect_equal(readLines(path_orderly), character()) }) -test_that("error if orderly.R exists already", { +test_that("error if orderly file exists already", { path <- test_prepare_orderly_example("data") expect_error(orderly_new("data", root = path), - "'src/data/orderly.R' already exists") + "'src/data/data.R' already exists") expect_error(orderly_new("data", force = TRUE, root = path), - "'src/data/orderly.R' already exists") + "'src/data/data.R' already exists") +}) + + +test_that("error two orderly file exist already", { + path <- test_prepare_orderly_example("two-orderly-files") + expect_error(orderly_new("two-orderly-files", force = TRUE, root = path), + paste("Please only create two-orderly-files.R file,", + "orderly.R has been deprecated")) }) @@ -75,31 +83,31 @@ test_that("error if a non-directory file is found in the src dir", { }) -test_that("allow creation of orderly.R in existing dir if force is given", { +test_that("allow creation of foo.R in existing src/foo if force is given", { path <- test_prepare_orderly_example(character()) fs::dir_create(file.path(path, "src", "foo")) - file.create(file.path(path, "src", "foo", "bar")) + file.create(file.path(path, "src", "foo", "deprebar")) err <- expect_error( orderly_new("foo", root = path), "'src/foo/' already exists and contains files") expect_equal( err$body, - c(i = paste("If you want to add an orderly.R to this directory,", + c(i = paste("If you want to add a foo.R to this directory,", "rerun `orderly_new()` with `force = TRUE`"))) expect_message( orderly_new("foo", force = TRUE, root = path), - "Created 'src/foo/orderly.R'") - expect_true(file.exists(file.path(path, "src/foo/orderly.R"))) + "Created 'src/foo/foo.R'") + expect_true(file.exists(file.path(path, "src/foo/foo.R"))) }) -test_that("allow creation of orderly.R in existing empty dir", { +test_that("allow creation of orderly file in existing empty dir", { path <- test_prepare_orderly_example(character()) fs::dir_create(file.path(path, "src", "foo")) expect_message( orderly_new("foo", root = path), - "Created 'src/foo/orderly.R'") - expect_true(file.exists(file.path(path, "src/foo/orderly.R"))) + "Created 'src/foo/foo.R'") + expect_true(file.exists(file.path(path, "src/foo/foo.R"))) }) diff --git a/tests/testthat/test-plugin.R b/tests/testthat/test-plugin.R index b422646d..be91da49 100644 --- a/tests/testthat/test-plugin.R +++ b/tests/testthat/test-plugin.R @@ -27,13 +27,13 @@ test_that("can run interactive example with plugin", { set.seed(1) path_src <- file.path(path, "src", "plugin") withr::with_dir(path_src, - sys.source("orderly.R", envir)) + sys.source("plugin.R", envir)) set.seed(1) cmp <- rnorm(10) expect_identical(envir$dat, cmp) - expect_setequal(dir(path_src), c("data.rds", "orderly.R")) + expect_setequal(dir(path_src), c("data.rds", "plugin.R")) expect_equal(readRDS(file.path(path_src, "data.rds")), cmp) }) diff --git a/tests/testthat/test-read.R b/tests/testthat/test-read.R index 058dff45..77f9c480 100644 --- a/tests/testthat/test-read.R +++ b/tests/testthat/test-read.R @@ -1,12 +1,14 @@ test_that("can read file with no helpers", { - expect_equal(orderly_read_r("examples/implicit/orderly.R"), - list(strict = list(enabled = FALSE))) + expect_equal(orderly_read_r("examples/implicit/implicit.R", "implicit.R"), + list(entrypoint_filename = "implicit.R", + strict = list(enabled = FALSE))) }) test_that("can read file with helpers", { - dat <- orderly_read_r("examples/explicit/orderly.R") - expect_setequal(names(dat), c("strict", "resources", "artefacts")) + dat <- orderly_read_r("examples/explicit/explicit.R", "explicit.R") + expect_setequal(names(dat), + c("entrypoint_filename", "strict", "resources", "artefacts")) expect_equal(dat$strict, list(enabled = FALSE)) expect_equal(dat$resources, "data.csv") expect_equal(dat$artefacts, @@ -16,7 +18,8 @@ test_that("can read file with helpers", { test_that("Skip over computed resources", { - dat <- orderly_read_r("examples/computed-resource/orderly.R") + dat <- orderly_read_r("examples/computed-resource/computed-resource.R", + "computed-resource.R") expect_null(dat$resources) }) diff --git a/tests/testthat/test-run-separate.R b/tests/testthat/test-run-separate.R index 2177368a..71b54421 100644 --- a/tests/testthat/test-run-separate.R +++ b/tests/testthat/test-run-separate.R @@ -21,7 +21,7 @@ test_that("can run shared resources case in separate directory", { root = info$outpack, root_src = info$src) expect_setequal( dir(file.path(info$outpack, "archive", "shared", id)), - c("shared_data.csv", "mygraph.png", "orderly.R")) + c("shared_data.csv", "mygraph.png", "shared.R")) }) @@ -66,6 +66,6 @@ test_that("can't run interactively in separate directory", { path_src <- file.path(info$src, "src", "depends") expect_error( withr::with_dir(path_src, - sys.source("orderly.R", envir2)), + sys.source("depends.R", envir2)), "orderly directory '.+' not initialised") }) diff --git a/tests/testthat/test-run.R b/tests/testthat/test-run.R index 1652037d..13fac677 100644 --- a/tests/testthat/test-run.R +++ b/tests/testthat/test-run.R @@ -10,7 +10,7 @@ test_that("can run simple task with explicit inputs and outputs", { path_res <- file.path(path, "archive", "explicit", id) expect_true(is_directory(path_res)) expect_setequal(dir(path_res), - c("orderly.R", "mygraph.png", "data.csv")) + c("explicit.R", "mygraph.png", "data.csv")) ## Nothing left in drafts expect_true(is_directory(file.path(path, "draft", "explicit"))) @@ -18,13 +18,13 @@ test_that("can run simple task with explicit inputs and outputs", { ## Nothing extra in src expect_setequal(dir(file.path(path, "src", "explicit")), - c("orderly.R", "data.csv")) + c("explicit.R", "data.csv")) meta <- orderly_metadata(id, root = path) expect_equal( meta$custom$orderly$role, - data_frame(path = c("orderly.R", "data.csv"), + data_frame(path = c("explicit.R", "data.csv"), role = c("orderly", "resource"))) expect_equal( meta$custom$orderly$artefacts, @@ -45,7 +45,7 @@ test_that("can run simple task with implicit inputs and outputs", { path_res <- file.path(path, "archive", "implicit", id) expect_true(is_directory(path_res)) expect_setequal(dir(path_res), - c("orderly.R", "mygraph.png", "data.csv")) + c("implicit.R", "mygraph.png", "data.csv")) ## Nothing left in drafts expect_true(is_directory(file.path(path, "draft", "implicit"))) @@ -53,12 +53,12 @@ test_that("can run simple task with implicit inputs and outputs", { ## Nothing extra in src expect_setequal(dir(file.path(path, "src", "implicit")), - c("orderly.R", "data.csv")) + c("implicit.R", "data.csv")) meta <- orderly_metadata(id, root = path) expect_equal(meta$custom$orderly$role, - data_frame(path = "orderly.R", + data_frame(path = "implicit.R", role = "orderly")) expect_equal(meta$custom$orderly$artefacts, data_frame(description = character(), @@ -69,7 +69,7 @@ test_that("can run simple task with implicit inputs and outputs", { test_that("error if declared artefacts are not produced", { path <- test_prepare_orderly_example("explicit") envir <- new.env() - path_src <- file.path(path, "src", "explicit", "orderly.R") + path_src <- file.path(path, "src", "explicit", "explicit.R") code <- readLines(path_src) writeLines(c( 'orderly2::orderly_artefact("some data", "output.csv")', @@ -82,14 +82,40 @@ test_that("error if declared artefacts are not produced", { }) +test_that("raises deprecation warning for orderly.R", { + path <- test_prepare_orderly_example("deprecated-orderly-name") + envir <- new.env() + rlang::reset_warning_verbosity("deprecate_orderly_file_name") + suppressMessages( + expect_warning( + orderly_run("deprecated-orderly-name", root = path, + envir = envir, echo = FALSE), + paste("Naming convention orderly.R will be deprecated", + "soon. Please change orderly file name to", + ".R") + ) + ) +}) + +test_that("throws error if orderly.R and .R found", { + path <- test_prepare_orderly_example("two-orderly-files") + envir <- new.env() + err <- expect_error( + orderly_run_quietly("two-orderly-files", root = path, + envir = envir), + paste("Please only create two-orderly-files.R file,", + "orderly.R has been deprecated")) +}) + + test_that("Can run explicit case without orderly", { path <- test_prepare_orderly_example("explicit") envir <- new.env() path_src <- file.path(path, "src", "explicit") withr::with_dir(path_src, - sys.source("orderly.R", envir)) + sys.source("explicit.R", envir)) expect_setequal(dir(path_src), - c("data.csv", "orderly.R", "mygraph.png")) + c("data.csv", "explicit.R", "mygraph.png")) }) @@ -99,7 +125,7 @@ test_that("cope with computed values in static functions", { id <- orderly_run_quietly("computed-resource", root = path, envir = envir) expect_setequal( dir(file.path(path, "archive", "computed-resource", id)), - c("data.csv", "mygraph.png", "orderly.R")) + c("data.csv", "mygraph.png", "computed-resource.R")) }) @@ -132,7 +158,7 @@ test_that("can run orderly with parameters, without orderly", { envir <- list2env(list(a = 10, c = 30), parent = new.env()) path_src <- file.path(path, "src", "parameters") withr::with_dir(path_src, - sys.source("orderly.R", envir)) + sys.source("parameters.R", envir)) path_rds <- file.path(path_src, "data.rds") expect_true(file.exists(path_rds)) @@ -148,7 +174,7 @@ test_that("can run orderly with parameters, without orderly, globally", { path_src <- file.path(path, "src", "depends-query") envir <- list2env(list(a = 10, b = 20, c = 30), parent = globalenv()) withr::with_dir(path_src, - suppressMessages(sys.source("orderly.R", envir))) + suppressMessages(sys.source("depends-query.R", envir))) path_rds <- file.path(path_src, "result.rds") expect_true(file.exists(path_rds)) expect_equal(readRDS(path_rds), list(a = 20, b = 40, c = 60)) @@ -178,8 +204,8 @@ test_that("Can run dependencies case without orderly", { envir2 <- new.env() path_src <- file.path(path, "src", "depends") withr::with_dir(path_src, - suppressMessages(sys.source("orderly.R", envir2))) - expect_setequal(dir(path_src), c("orderly.R", "input.rds", "graph.png")) + suppressMessages(sys.source("depends.R", envir2))) + expect_setequal(dir(path_src), c("depends.R", "input.rds", "graph.png")) expect_equal( unname(tools::md5sum(file.path(path_src, "input.rds"))), unname(tools::md5sum(file.path(path, "archive", "data", id1, "data.rds")))) @@ -211,14 +237,14 @@ test_that("can run with shared resources", { id <- orderly_run_quietly("shared", root = path, envir = envir) expect_setequal( dir(file.path(path, "archive", "shared", id)), - c("shared_data.csv", "mygraph.png", "orderly.R")) + c("shared_data.csv", "mygraph.png", "shared.R")) meta <- orderly_metadata(id, root = path) expect_equal(nrow(meta$custom$orderly$shared), 1) expect_equal(meta$custom$orderly$shared, data_frame(here = "shared_data.csv", there = "data.csv")) expect_equal( meta$custom$orderly$role, - data_frame(path = c("orderly.R", "shared_data.csv"), + data_frame(path = c("shared.R", "shared_data.csv"), role = c("orderly", "shared"))) }) @@ -228,10 +254,10 @@ test_that("can run manually with shared resources", { envir <- new.env() path_src <- file.path(path, "src", "shared") withr::with_dir(path_src, - sys.source("orderly.R", envir)) + sys.source("shared.R", envir)) expect_setequal( dir(path_src), - c("shared_data.csv", "mygraph.png", "orderly.R")) + c("shared_data.csv", "mygraph.png", "shared.R")) }) @@ -260,7 +286,7 @@ test_that("can't use shared resources if not enabled", { orderly_run_quietly("shared", root = path, envir = envir), "The shared resources directory 'shared' does not exist at orderly's root") expect_error( - withr::with_dir(path_src, sys.source("orderly.R", envir)), + withr::with_dir(path_src, sys.source("shared.R", envir)), "The shared resources directory 'shared' does not exist at orderly's root") }) @@ -277,7 +303,7 @@ test_that("shared resources can be directories", { expect_setequal( dir(file.path(path, "archive", "shared-dir", id)), - c("shared_data", "output.rds", "orderly.R")) + c("shared_data", "output.rds", "shared-dir.R")) expect_setequal( dir(file.path(path, "archive", "shared-dir", id, "shared_data")), c("iris.csv", "mtcars.csv")) @@ -290,7 +316,7 @@ test_that("shared resources can be directories", { expect_equal( meta$custom$orderly$role, data_frame( - path = c("orderly.R", "shared_data/iris.csv", + path = c("shared-dir.R", "shared_data/iris.csv", "shared_data/mtcars.csv"), role = c("orderly", "shared", "shared"))) d <- readRDS(file.path(path, "archive", "shared-dir", id, "output.rds")) @@ -318,7 +344,7 @@ test_that("can add description metadata", { test_that("can't use description twice in one packet", { path <- test_prepare_orderly_example("description") envir <- new.env() - path_orderly <- file.path(path, "src", "description", "orderly.R") + path_orderly <- file.path(path, "src", "description", "description.R") code <- readLines(path_orderly) writeLines(c(code, "orderly2::orderly_description()"), path_orderly) expect_error( @@ -331,7 +357,7 @@ test_that("can't use description twice in one packet", { test_that("can't use description twice by being sneaky", { path <- test_prepare_orderly_example("description") envir <- new.env() - path_orderly <- file.path(path, "src", "description", "orderly.R") + path_orderly <- file.path(path, "src", "description", "description.R") code <- readLines(path_orderly) writeLines(c(code, "for (i in 1:2) orderly2::orderly_description()"), path_orderly) @@ -344,7 +370,7 @@ test_that("can't use description twice by being sneaky", { test_that("with strict mode, only declared files are copied, running fails", { path <- test_prepare_orderly_example("implicit") - path_src <- file.path(path, "src", "implicit", "orderly.R") + path_src <- file.path(path, "src", "implicit", "implicit.R") code <- readLines(path_src) writeLines(c("orderly2::orderly_strict_mode()", code), path_src) err <- suppressWarnings(tryCatch(read.csv("data.csv"), error = identity)) @@ -357,7 +383,7 @@ test_that("with strict mode, only declared files are copied, running fails", { test_that("with strict mode, indicate unknown files as potential artefacts", { path <- test_prepare_orderly_example("implicit") - path_src <- file.path(path, "src", "implicit", "orderly.R") + path_src <- file.path(path, "src", "implicit", "implicit.R") code <- readLines(path_src) writeLines(c("orderly2::orderly_strict_mode()", 'orderly2::orderly_resource("data.csv")', @@ -370,7 +396,7 @@ test_that("with strict mode, indicate unknown files as potential artefacts", { all = FALSE) expect_setequal( dir(file.path(path, "archive", "implicit", id)), - c("orderly.R", "mygraph.png", "data.csv")) + c("implicit.R", "mygraph.png", "data.csv")) }) @@ -385,13 +411,13 @@ test_that("without strict mode, detect modified files", { fixed = TRUE, all = FALSE) expect_setequal( dir(file.path(path, "archive", "implicit", id)), - c("orderly.R", "mygraph.png", "data.csv")) + c("implicit.R", "mygraph.png", "data.csv")) }) test_that("disallow multiple calls to strict mode", { path <- test_prepare_orderly_example("implicit") - path_src <- file.path(path, "src", "implicit", "orderly.R") + path_src <- file.path(path, "src", "implicit", "implicit.R") code <- readLines(path_src) writeLines(c("if (TRUE) {", " orderly2::orderly_strict_mode()", @@ -419,11 +445,11 @@ test_that("can copy resource from directory, implicitly", { meta <- orderly_metadata(id, root = path) expect_equal(meta$custom$orderly$role, - data_frame(path = "orderly.R", + data_frame(path = "resource-in-directory.R", role = "orderly")) expect_setequal( meta$files$path, - c("data.rds", "data/a.csv", "data/b.csv", "orderly.R")) + c("data.rds", "data/a.csv", "data/b.csv", "resource-in-directory.R")) expect_true(file.exists( file.path(path, "archive", "resource-in-directory", id, "data.rds"))) }) @@ -432,7 +458,8 @@ test_that("can copy resource from directory, implicitly", { test_that("fail to copy resource from directory, implicitly, strictly", { path <- test_prepare_orderly_example("resource-in-directory") envir <- new.env() - path_src <- file.path(path, "src", "resource-in-directory", "orderly.R") + path_src <- file.path(path, "src", "resource-in-directory", + "resource-in-directory.R") prepend_lines(path_src, "orderly2::orderly_strict_mode()") err <- suppressWarnings(tryCatch(read.csv("data/a.csv"), error = identity)) expect_error(suppressWarnings( @@ -445,7 +472,8 @@ test_that("fail to copy resource from directory, implicitly, strictly", { test_that("can copy resource from directory, included by file", { path <- test_prepare_orderly_example("resource-in-directory") envir <- new.env() - path_src <- file.path(path, "src", "resource-in-directory", "orderly.R") + path_src <- file.path(path, "src", "resource-in-directory", + "resource-in-directory.R") prepend_lines(path_src, c('orderly2::orderly_resource("data/a.csv")', 'orderly2::orderly_resource("data/b.csv")')) @@ -453,7 +481,7 @@ test_that("can copy resource from directory, included by file", { meta <- orderly_metadata(id, root = path) expect_equal( meta$custom$orderly$role, - data_frame(path = c("orderly.R", "data/a.csv", "data/b.csv"), + data_frame(path = c("resource-in-directory.R", "data/a.csv", "data/b.csv"), role = c("orderly", "resource", "resource"))) expect_true(file.exists( file.path(path, "archive", "resource-in-directory", id, "data.rds"))) @@ -463,7 +491,8 @@ test_that("can copy resource from directory, included by file", { test_that("can copy resource from directory, included by file, strict mode", { path <- test_prepare_orderly_example("resource-in-directory") envir <- new.env() - path_src <- file.path(path, "src", "resource-in-directory", "orderly.R") + path_src <- file.path(path, "src", "resource-in-directory", + "resource-in-directory.R") prepend_lines(path_src, c("orderly2::orderly_strict_mode()", 'orderly2::orderly_resource("data/a.csv")', @@ -472,7 +501,7 @@ test_that("can copy resource from directory, included by file, strict mode", { meta <- orderly_metadata(id, root = path) expect_equal( meta$custom$orderly$role, - data_frame(path = c("orderly.R", "data/a.csv", "data/b.csv"), + data_frame(path = c("resource-in-directory.R", "data/a.csv", "data/b.csv"), role = c("orderly", "resource", "resource"))) expect_true(file.exists( file.path(path, "archive", "resource-in-directory", id, "data.rds"))) @@ -482,14 +511,15 @@ test_that("can copy resource from directory, included by file, strict mode", { test_that("can copy resource from directory, included by directory", { path <- test_prepare_orderly_example("resource-in-directory") envir <- new.env() - path_src <- file.path(path, "src", "resource-in-directory", "orderly.R") + path_src <- file.path(path, "src", "resource-in-directory", + "resource-in-directory.R") prepend_lines(path_src, 'orderly2::orderly_resource("data")') id <- orderly_run_quietly("resource-in-directory", root = path, envir = envir) meta <- orderly_metadata(id, root = path) expect_equal( meta$custom$orderly$role, - data_frame(path = c("orderly.R", "data/a.csv", "data/b.csv"), + data_frame(path = c("resource-in-directory.R", "data/a.csv", "data/b.csv"), role = c("orderly", "resource", "resource"))) expect_true(file.exists( file.path(path, "archive", "resource-in-directory", id, "data.rds"))) @@ -499,7 +529,8 @@ test_that("can copy resource from directory, included by directory", { test_that("can copy resource from directory, included by directory, strictly", { path <- test_prepare_orderly_example("resource-in-directory") envir <- new.env() - path_src <- file.path(path, "src", "resource-in-directory", "orderly.R") + path_src <- file.path(path, "src", "resource-in-directory", + "resource-in-directory.R") prepend_lines(path_src, c("orderly2::orderly_strict_mode()", 'orderly2::orderly_resource("data")')) @@ -508,7 +539,7 @@ test_that("can copy resource from directory, included by directory, strictly", { meta <- orderly_metadata(id, root = path) expect_equal( meta$custom$orderly$role, - data_frame(path = c("orderly.R", "data/a.csv", "data/b.csv"), + data_frame(path = c("resource-in-directory.R", "data/a.csv", "data/b.csv"), role = c("orderly", "resource", "resource"))) expect_true(file.exists( file.path(path, "archive", "resource-in-directory", id, "data.rds"))) @@ -549,21 +580,22 @@ test_that("can pull resources programmatically", { meta2 <- orderly_metadata(id2, root = path) expect_equal(meta1$custom$orderly$role, - data_frame(path = c("orderly.R", "a.csv"), + data_frame(path = c("programmatic-resource.R", "a.csv"), role = c("orderly", "resource"))) expect_equal(meta2$custom$orderly$role, - data_frame(path = c("orderly.R", "b.csv"), + data_frame(path = c("programmatic-resource.R", "b.csv"), role = c("orderly", "resource"))) expect_setequal(meta1$files$path, - c("a.csv", "b.csv", "data.rds", "orderly.R")) + c("a.csv", "b.csv", "data.rds", "programmatic-resource.R")) expect_setequal(meta2$files$path, - c("a.csv", "b.csv", "data.rds", "orderly.R")) + c("a.csv", "b.csv", "data.rds", "programmatic-resource.R")) }) test_that("can pull resources programmatically, strictly", { path <- test_prepare_orderly_example("programmatic-resource") - path_src <- file.path(path, "src", "programmatic-resource", "orderly.R") + path_src <- file.path(path, "src", "programmatic-resource", + "programmatic-resource.R") prepend_lines(path_src, "orderly2::orderly_strict_mode()") id1 <- orderly_run_quietly("programmatic-resource", list(use = "a"), root = path) @@ -573,15 +605,15 @@ test_that("can pull resources programmatically, strictly", { meta2 <- meta <- orderly_metadata(id2, root = path) expect_equal(meta1$custom$orderly$role, - data_frame(path = c("orderly.R", "a.csv"), + data_frame(path = c("programmatic-resource.R", "a.csv"), role = c("orderly", "resource"))) expect_equal(meta2$custom$orderly$role, - data_frame(path = c("orderly.R", "b.csv"), + data_frame(path = c("programmatic-resource.R", "b.csv"), role = c("orderly", "resource"))) expect_setequal(meta1$files$path, - c("a.csv", "data.rds", "orderly.R")) + c("a.csv", "data.rds", "programmatic-resource.R")) expect_setequal(meta2$files$path, - c("b.csv", "data.rds", "orderly.R")) + c("b.csv", "data.rds", "programmatic-resource.R")) }) @@ -590,7 +622,7 @@ test_that("can fetch information about the context", { envir1 <- new.env() id1 <- orderly_run_quietly("data", root = path, envir = envir1) - path_src <- file.path(path, "src", "depends", "orderly.R") + path_src <- file.path(path, "src", "depends", "depends.R") code <- readLines(path_src) writeLines(c(code, 'saveRDS(orderly2::orderly_run_info(), "info.rds")'), path_src) @@ -614,7 +646,7 @@ test_that("can fetch information interactively", { path <- test_prepare_orderly_example(c("data", "depends")) envir1 <- new.env() id1 <- orderly_run_quietly("data", root = path, envir = envir1) - path_src <- file.path(path, "src", "depends", "orderly.R") + path_src <- file.path(path, "src", "depends", "depends.R") code <- readLines(path_src) writeLines(c(code, 'saveRDS(orderly2::orderly_run_info(), "info.rds")'), path_src) @@ -622,7 +654,7 @@ test_that("can fetch information interactively", { envir2 <- new.env() path_src <- file.path(path, "src", "depends") withr::with_dir(path_src, - suppressMessages(sys.source("orderly.R", envir2))) + suppressMessages(sys.source("depends.R", envir2))) path2 <- file.path(path, "src", "depends") d <- readRDS(file.path(path2, "info.rds")) @@ -640,7 +672,7 @@ test_that("cope with failed run", { path <- test_prepare_orderly_example("explicit") envir <- new.env() - append_lines(file.path(path, "src", "explicit", "orderly.R"), + append_lines(file.path(path, "src", "explicit", "explicit.R"), 'readRDS("somepath.rds")') err <- expect_error(suppressWarnings( orderly_run_quietly("explicit", root = path, envir = envir, echo = FALSE))) @@ -728,7 +760,7 @@ test_that("can select location when querying dependencies interactively", { envir2 <- new.env() path_src <- file.path(path[["us"]], "src", "depends") withr::with_dir(path_src, - suppressMessages(sys.source("orderly.R", envir2))) + suppressMessages(sys.source("depends.R", envir2))) ## Correct file was pulled in: expect_equal( @@ -745,7 +777,7 @@ test_that("can use a resource from a directory", { meta <- orderly_metadata(id, root = path) expect_equal( meta$custom$orderly$role, - data_frame(path = c("orderly.R", "data/a.csv", "data/b.csv"), + data_frame(path = c("directories.R", "data/a.csv", "data/b.csv"), role = c("orderly", "resource", "resource"))) expect_equal( meta$custom$orderly$artefacts, @@ -761,14 +793,14 @@ test_that("can use a resource from a directory", { meta <- orderly_metadata(id, root = path) expect_equal( meta$custom$orderly$role, - data_frame(path = c("orderly.R", "data/a.csv", "data/b.csv"), + data_frame(path = c("directories.R", "data/a.csv", "data/b.csv"), role = c("orderly", "resource", "resource"))) expect_equal( meta$custom$orderly$artefacts, data_frame(description = "output files", paths = I(list(list("output/a.rds", "output/b.rds"))))) expect_setequal(meta$files$path, - c("data/a.csv", "data/b.csv", "orderly.R", + c("data/a.csv", "data/b.csv", "directories.R", "output/a.rds", "output/b.rds")) }) @@ -785,7 +817,7 @@ test_that("can depend on a directory artefact", { 'orderly2::orderly_artefact("data", "d.rds")', 'd <- c(readRDS("d/a.rds", "d/b.rds"))', 'saveRDS(d, "d.rds")'), - file.path(path_src, "orderly.R")) + file.path(path_src, "use.R")) envir2 <- new.env() id2 <- orderly_run_quietly("use", root = path, envir = envir2) meta <- orderly_metadata(id2, root = path) @@ -813,7 +845,7 @@ test_that("can compute dependencies", { ' c(d.rds = "data.rds"))', 'orderly2::orderly_artefact("data", "d.rds")') - writeLines(code, file.path(path_src, "orderly.R")) + writeLines(code, file.path(path_src, "use.R")) envir2 <- new.env() expect_error( orderly_run_quietly("use", root = path, envir = envir2), @@ -835,7 +867,7 @@ test_that("can compute dependencies", { expect_equal(meta$depends$query, 'latest(parameter:a == 3 && name == "parameters")') - writeLines(c("x <- 1", code), file.path(path_src, "orderly.R")) + writeLines(c("x <- 1", code), file.path(path_src, "use.R")) id <- orderly_run_quietly("use", root = path, envir = envir2) expect_equal(orderly_metadata(id, root = path)$depends$packet, id1) @@ -865,7 +897,7 @@ test_that("validation of orderly directories", { root <- root_open(path, FALSE, TRUE) nms <- sprintf("example_%s", letters[1:8]) fs::dir_create(file.path(path, "src", nms)) - file.create(file.path(path, "src", nms, "orderly.R")) + file.create(file.path(path, "src", nms, sprintf("%s.R", nms))) hint_root <- sprintf("Looked relative to orderly root at '%s'", path) err <- expect_error( @@ -886,11 +918,8 @@ test_that("validation of orderly directories", { fs::dir_create(file.path(path, "src", "bar")) err <- expect_error( validate_orderly_directory("bar", path), - "Did not find orderly report 'bar'") - expect_equal( - err$body, - c(x = "The path 'src/bar' exists but does not contain 'orderly.R'", - i = hint_root)) + "Please create bar.R file" + ) hint_close <- sprintf("Did you mean %s", paste(squote(nms[1:5]), collapse = ", ")) @@ -914,12 +943,8 @@ test_that("validation of orderly directories", { fs::dir_create(file.path(path, "src", "example_x")) err <- expect_error( validate_orderly_directory("example_x", path), - "Did not find orderly report 'example_x'") - expect_equal( - err$body, - c(x = "The path 'src/example_x' exists but does not contain 'orderly.R'", - i = hint_close, - i = hint_root)) + "Please create example_x.R file" + ) }) @@ -928,7 +953,7 @@ test_that("strip extraneous path components from orderly path", { root <- root_open(path, FALSE, TRUE) fs::dir_create(file.path(path, "src", "example_a")) - file.create(file.path(path, "src", "example_a", "orderly.R")) + file.create(file.path(path, "src", "example_a", "example_a.R")) expect_equal(validate_orderly_directory("example_a", path), "example_a") @@ -949,7 +974,7 @@ test_that("strip extraneous path components from orderly path", { ## Pathalogical case: fs::dir_create(file.path(path, "src", "src")) - file.create(file.path(path, "src", "src", "orderly.R")) + file.create(file.path(path, "src", "src", "src.R")) expect_equal(validate_orderly_directory("src", path), "src") @@ -985,7 +1010,7 @@ test_that("can rename dependencies programmatically", { ' c("${p}/data.rds" = "data.rds"))', 'd <- readRDS(file.path(p, "data.rds"))', 'saveRDS(d, "d.rds")'), - file.path(path_src, "orderly.R")) + file.path(path_src, "use.R")) envir2 <- new.env() id2 <- orderly_run_quietly("use", root = path, envir = envir2) meta <- orderly_metadata(id2, root = path) @@ -999,7 +1024,7 @@ test_that("can rename dependencies programmatically", { test_that("can detect device imbalance", { path <- test_prepare_orderly_example("explicit") - path_src <- file.path(path, "src", "explicit", "orderly.R") + path_src <- file.path(path, "src", "explicit", "explicit.R") code <- readLines(path_src) writeLines(code[!grepl("^dev.off", code)], path_src) @@ -1019,7 +1044,7 @@ test_that("can use quote for queries queries", { path <- test_prepare_orderly_example(c("data", "depends")) id1 <- c(orderly_run_quietly("data", envir = new.env(), root = path), orderly_run_quietly("data", envir = new.env(), root = path)) - path_src <- file.path(path, "src", "depends", "orderly.R") + path_src <- file.path(path, "src", "depends", "depends.R") src <- readLines(path_src) writeLines(sub('"latest"', "quote(latest())", src, fixed = TRUE), path_src) id2 <- orderly_run_quietly("depends", root = path) @@ -1046,7 +1071,7 @@ test_that("can describe misses for dependencies", { test_that("can run example with artefacts and no resources", { path <- test_prepare_orderly_example("implicit") - path_src <- file.path(path, "src", "implicit", "orderly.R") + path_src <- file.path(path, "src", "implicit", "implicit.R") file.create(file.path(dirname(path_src), "mygraph.png")) envir <- new.env() @@ -1135,11 +1160,11 @@ test_that("can read about assigned resources", { path <- test_prepare_orderly_example("directories") path_src <- file.path(path, "src", "directories") - code <- readLines(file.path(path_src, "orderly.R")) + code <- readLines(file.path(path_src, "directories.R")) code <- sub("orderly2::orderly_resource", "r <- orderly2::orderly_resource", code) code <- c(code, 'writeLines(r, "resources.txt")') - writeLines(code, file.path(path_src, "orderly.R")) + writeLines(code, file.path(path_src, "directories.R")) id <- orderly_run_quietly("directories", root = path) expect_setequal( @@ -1165,12 +1190,12 @@ test_that("can read about assigned shared resources", { row.names = FALSE) path_src <- file.path(path, "src", "shared-dir") - code <- readLines(file.path(path_src, "orderly.R")) + code <- readLines(file.path(path_src, "shared-dir.R")) code <- sub("orderly2::orderly_shared_resource", "r <- orderly2::orderly_shared_resource", code) code <- c(code, 'saveRDS(r, "resources.rds")') - writeLines(code, file.path(path_src, "orderly.R")) + writeLines(code, file.path(path_src, "shared-dir.R")) id <- orderly_run_quietly("shared-dir", root = path) r <- readRDS(file.path(path, "archive", "shared-dir", id, "resources.rds")) @@ -1195,12 +1220,12 @@ test_that("can read about dependencies", { id1 <- orderly_run_quietly("data", envir = new.env(), root = path) path_src <- file.path(path, "src", "depends") - code <- readLines(file.path(path_src, "orderly.R")) + code <- readLines(file.path(path_src, "depends.R")) code <- sub("orderly2::orderly_dependency", "r <- orderly2::orderly_dependency", code) code <- c(code, 'saveRDS(r, "depends.rds")') - writeLines(code, file.path(path_src, "orderly.R")) + writeLines(code, file.path(path_src, "depends.R")) id2 <- orderly_run_quietly("depends", root = path) r <- readRDS(file.path(path, "archive", "depends", id2, "depends.rds")) @@ -1240,7 +1265,7 @@ test_that("can add a dependency on an id with no name", { envir1 <- new.env() id1 <- orderly_run_quietly("data", root = path, envir = envir1) - path_src <- file.path(path, "src", "depends", "orderly.R") + path_src <- file.path(path, "src", "depends", "depends.R") code <- readLines(path_src) i <- grep("orderly2::orderly_dependency", code) code[[i]] <- sprintf( diff --git a/tests/testthat/test-zzz-location-http.R b/tests/testthat/test-zzz-location-http.R index ee46b5c0..6f93e760 100644 --- a/tests/testthat/test-zzz-location-http.R +++ b/tests/testthat/test-zzz-location-http.R @@ -111,13 +111,18 @@ describe("http location integration tests", { root_tmp <- create_temporary_root(use_file_store = TRUE) id_tmp <- create_random_packet(root_tmp) - hash_bad <- hash_data("", "sha256") + hash <- root_tmp$index$metadata(id_tmp)$files$hash meta <- read_string( file.path(root_tmp$path, ".outpack", "metadata", id_tmp)) + orderly_location_http$new(url)$push_file( + find_file_by_hash(root_tmp, hash), + hash + ) + ## Trigger the error directly: cl <- outpack_http_client$new(url) - err <- expect_error(cl$post(sprintf("/packet/%s", hash_bad), meta, + err <- expect_error(cl$post(sprintf("/packet/%s", hash), meta, httr::content_type("text/plain")), "Expected hash '.+' but found '.+'") }) diff --git a/vignettes/dependencies.Rmd b/vignettes/dependencies.Rmd index 97cb78a2..2bcab155 100644 --- a/vignettes/dependencies.Rmd +++ b/vignettes/dependencies.Rmd @@ -28,7 +28,7 @@ Here, we show how to practically use dependencies in a few common scenarios of i ## Basic use -The primary mechanism for using dependencies is to call `orderly2::orderly_dependency()` from within an `orderly.R` script; this finds a suitable completed packet and copies files that are found from within that packet into your current report. +The primary mechanism for using dependencies is to call `orderly2::orderly_dependency()` from within an orderly file; this finds a suitable completed packet and copies files that are found from within that packet into your current report. ```{r, include = FALSE} path <- tempfile() @@ -42,7 +42,7 @@ writeLines(c( 'd <- read.csv("data.csv")', "d$z <- resid(lm(y ~ x, d))", 'saveRDS(d, "data.rds")'), - file.path(path, "src", "data", "orderly.R")) + file.path(path, "src", "data", "data.R")) orderly2::orderly_run("data", root = path) fs::dir_create(file.path(path, "src", "analysis")) @@ -52,18 +52,18 @@ writeLines(c( 'png("analysis.png")', "plot(y ~ x, d)", "dev.off()"), - file.path(path, "src", "analysis", "orderly.R")) + file.path(path, "src", "analysis", "analysis.R")) ``` ```{r, echo = FALSE} dir_tree(file.path(path), "src") ``` -and `src/analysis/orderly.R` contains: +and `src/analysis/analysis.R` contains: ```{r, echo = FALSE, results = "asis"} -r_output(readLines(file.path(path, "src/analysis/orderly.R"))) +r_output(readLines(file.path(path, "src/analysis/analysis.R"))) ``` Here, we've used `orderly2::orderly_dependency()` to pull in the file `data.rds` from the most recent version (`latest()`) of the `data` packet, then we've used that file as normal to make a plot, which we've saved as `analysis.png` (this is very similar to the example from `vignette("introduction")`, to get us started). @@ -94,7 +94,7 @@ writeLines(c( "orderly2::orderly_parameters(cyl = NULL)", "d <- mtcars[mtcars$cyl == cyl, ]", 'saveRDS(d, "data.rds")'), - file.path(path, "src", "data", "orderly.R")) + file.path(path, "src", "data", "data.R")) fs::dir_create(file.path(path, "src", "analysis")) writeLines(c( @@ -107,17 +107,17 @@ writeLines(c( 'png("analysis.png")', "plot(mpg ~ disp, d)", "dev.off()"), - file.path(path, "src", "analysis", "orderly.R")) + file.path(path, "src", "analysis", "analysis.R")) ``` ```{r, echo = FALSE} dir_tree(file.path(path), "src") ``` -with `src/data/orderly.R` containing: +with `src/data/data.R` containing: ```{r, echo = FALSE, results = "asis"} -r_output(readLines(file.path(path, "src/data/orderly.R"))) +r_output(readLines(file.path(path, "src/data/data.R"))) ``` We can run this for several values of `cyl`: @@ -131,7 +131,7 @@ orderly2::orderly_run("data", list(cyl = 8)) Our follow-on analysis contains: ```{r, echo = FALSE, results = "asis"} -r_output(readLines(file.path(path, "src/analysis/orderly.R"))) +r_output(readLines(file.path(path, "src/analysis/analysis.R"))) ``` Here the query `latest(parameter:cyl == this:cyl)` says "find the most recent packet where it's parameter "cyl" (`parameter:cyl`) is the same as the parameter in the currently running report (`this:cyl`). diff --git a/vignettes/introduction.Rmd b/vignettes/introduction.Rmd index 4ffdd84d..989edc8c 100644 --- a/vignettes/introduction.Rmd +++ b/vignettes/introduction.Rmd @@ -61,7 +61,7 @@ setwd(path) # Creating your first orderly report -An orderly report is a directory `src/` containing a file `orderly.R`. That file may have special commands in it, but for now we'll create one that is as simple as possible; we'll create some random data and save it to disk. This seems silly, but imagine this standing in for something like: +An orderly report is a directory `src/` containing an orderly file `.R`. That file may have special commands in it, but for now we'll create one that is as simple as possible; we'll create some random data and save it to disk. This seems silly, but imagine this standing in for something like: * downloading file from some external site or resource * running a simulation and saving output @@ -77,7 +77,7 @@ writeLines(c( 'd <- read.csv("data.csv")', "d$z <- resid(lm(y ~ x, d))", 'saveRDS(d, "data.rds")'), - file.path(path, "src", "incoming_data", "orderly.R")) + file.path(path, "src", "incoming_data", "incoming_data.R")) ``` Our directory structure (ignoring `.outpack`) looks like: @@ -86,11 +86,11 @@ Our directory structure (ignoring `.outpack`) looks like: dir_tree(path, all = FALSE) ``` -and `src/incoming_data/orderly.R` contains: +and `src/incoming_data/incoming_data.R` contains: ```{r, echo = FALSE, results = "asis"} -r_output(readLines(file.path(path, "src/incoming_data/orderly.R"))) +r_output(readLines(file.path(path, "src/incoming_data/incoming_data.R"))) ``` To run the report and create a new **packet**, use `orderly2::orderly_run()`: @@ -113,12 +113,12 @@ A few things have changed here: * we have a directory `r paste0("archive/incoming_data/", id)`; this directory contains - the file that was created when we ran the report (`data.rds`; see the script above) - a log of what happened when the report was run and the packet was created - - `orderly.R` and `data.csv`, the original input that have come from our source tree + - `incoming_data.R` and `data.csv`, the original input that have come from our source tree * there is an empty directory `draft/incoming_data` which was created when orderly ran the report in the first place In addition, quite a few files have changed within the `.outpack` directory, but these are not covered here. -That's it! Notice that the initial script is just a plain R script, and you can develop it interactively from within the `src/incoming_data` directory. Note however, that any paths referred to within will be relative to `src/incoming_data` and **not** the orderly repository root. This is important as all reports only see the world relative to their `orderly.R` file. +That's it! Notice that the initial script is just a plain R script, and you can develop it interactively from within the `src/incoming_data` directory. Note however, that any paths referred to within will be relative to `src/incoming_data` and **not** the orderly repository root. This is important as all reports only see the world relative to their `incoming_data.R` file. Once created, you can then refer to this report by id and pull its files wherever you need them, both in the context of another orderly report or just to copy to your desktop to email someone. For example, to copy the file `data.rds` that we created to some location outside of orderly's control you could do @@ -133,7 +133,7 @@ which copies `data.rds` to some new temporary directory `dest` with name `final. # Depending on packets from another report -Creating a new dataset is mostly useful if someone else can use it. To do this we introduce the first of the special orderly commands that you can use from `orderly.R` +Creating a new dataset is mostly useful if someone else can use it. To do this we introduce the first of the special orderly commands that you can use from an orderly file ```{r, include = FALSE} fs::dir_create(file.path(path, "src", "analysis")) @@ -144,7 +144,7 @@ writeLines(c( 'png("analysis.png")', "plot(y ~ x, d)", "dev.off()"), - file.path(path, "src", "analysis", "orderly.R")) + file.path(path, "src", "analysis", "analysis.R")) ``` The `src/` directory now looks like: @@ -153,11 +153,11 @@ The `src/` directory now looks like: dir_tree(file.path(path), "src") ``` -and `src/analysis/orderly.R` contains: +and `src/analysis/analysis.R` contains: ```{r, echo = FALSE, results = "asis"} -r_output(readLines(file.path(path, "src/analysis/orderly.R"))) +r_output(readLines(file.path(path, "src/analysis/analysis.R"))) ``` Here, we've used `orderly2::orderly_dependency()` to pull in the file `data.rds` from the most recent version (`latest()`) of the `data` packet with the filename `incoming.rds`, then we've used that file as normal to make a plot, which we've saved as `analysis.png`. @@ -187,18 +187,18 @@ In addition, there is also a function `orderly::orderly_run_info()` that can be Let's add some additional annotations to the previous reports: ```{r, include = FALSE} -code_data <- readLines(file.path(path, "src", "incoming_data", "orderly.R")) +code_data <- readLines(file.path(path, "src", "incoming_data", "incoming_data.R")) writeLines(c( "orderly2::orderly_strict_mode()", 'orderly2::orderly_resource("data.csv")', 'orderly2::orderly_artefact("Processed data", "data.rds")', "", code_data), - file.path(path, "src", "incoming_data", "orderly.R")) + file.path(path, "src", "incoming_data", "incoming_data.R")) ``` ```{r, echo = FALSE, results = "asis"} -r_output(readLines(file.path(path, "src/incoming_data/orderly.R"))) +r_output(readLines(file.path(path, "src/incoming_data/incoming_data.R"))) ``` Here, we've added a block of special orderly commands; these could go anywhere, for example above the files that they refer to. If strict mode is enabled (see below) then `orderly2::orderly_resource` calls must go before the files are used as they will only be made available at that point (see below). @@ -220,11 +220,11 @@ writeLines(c( "x <- seq_len(n_samples)", "d <- data.frame(x = x, y = x + rnorm(n_samples))", 'saveRDS(d, "data.rds")'), - file.path(path, "src", "random", "orderly.R")) + file.path(path, "src", "random", "random.R")) ``` ```{r, echo = FALSE, results = "asis"} -r_output(readLines(file.path(path, "src/random/orderly.R"))) +r_output(readLines(file.path(path, "src/random/random.R"))) ``` This creates a report that has a single parameter `n_samples` with a default value of 10. We could have used @@ -306,7 +306,7 @@ write.csv(data.frame(x = 1:10, y = runif(10)), dir_tree(path) ``` -We can then write an orderly report `use_shared` that uses this shared file, with its `orderly.R` containing: +We can then write an orderly report `use_shared` that uses this shared file, with its `use_shared.R` containing: ```{r, echo = FALSE, results = "asis"} fs::dir_create(file.path(path, "src", "use_shared")) @@ -318,8 +318,8 @@ writeLines(c( 'png("analysis.png")', "plot(y ~ x, d)", "dev.off()"), - file.path(path, "src", "use_shared", "orderly.R")) -r_output(readLines(file.path(path, "src/use_shared/orderly.R"))) + file.path(path, "src", "use_shared", "use_shared.R")) +r_output(readLines(file.path(path, "src/use_shared/use_shared.R"))) ``` We can run this: @@ -344,24 +344,24 @@ The previous version of orderly (`orderly1`; see `vignette("migrating")`) was ve orderly2::orderly_strict_mode() ``` -anywhere within your `orderly.R` script (conventionally at the top). We may make this more granular in future, but by adding this we: +anywhere within your orderly file (conventionally at the top). We may make this more granular in future, but by adding this we: -* only copy files from the source directory (`src//`) to the draft directory where the report runs (`draft//`) that were declared with `orderly2::orderly_resource`; this leaves behind any extra files left over in development +* only copy files from the source directory (`src//`) to the draft directory where the report runs (`draft//`) that were declared with `orderly2::orderly_resource`; this leaves behind any extra files left over in development * warn at the end of running a packet if any files are found that are not part of an artefact -Using strict mode also helps `orderly2` clean up the `src/` directory more effectively after interactive development (see next section). +Using strict mode also helps `orderly2` clean up the `src/` directory more effectively after interactive development (see next section). # Interactive development -Set your working directory to `src/` and any orderly script should be fully executable (e.g., source with Rstudio's `Source` button, or R's `source()` function). Dependencies will be copied over as needed. +Set your working directory to `src/` and any orderly script should be fully executable (e.g., source with Rstudio's `Source` button, or R's `source()` function). Dependencies will be copied over as needed. After doing this, you will have a mix of files within your source directory. We recommend a per-source-directory `.gitignore` which will keep these files out of version control (see below). We will soon implement support for cleaning up generated files from this directory. -For example, suppose that we have interactively run our `incoming_data/orderly.R` script, we would leave behind generated files. We can report on this with `orderly2::orderly_cleanup_status`: +For example, suppose that we have interactively run our `incoming_data/incoming_data.R` script, we would leave behind generated files. We can report on this with `orderly2::orderly_cleanup_status`: ```{r, include = FALSE} withr::with_dir(file.path(path, "src/incoming_data"), - sys.source("orderly.R", new.env(parent = .GlobalEnv))) + sys.source("incoming_data.R", new.env(parent = .GlobalEnv))) ``` ```{r, inwd = path} diff --git a/vignettes/migrating.Rmd b/vignettes/migrating.Rmd index 5a4481fd..1e3e76f9 100644 --- a/vignettes/migrating.Rmd +++ b/vignettes/migrating.Rmd @@ -17,7 +17,7 @@ If you have never used version 1.x of orderly, you should not read this document ## So long YAML and thanks for all the whitespace errors -The most obvious user-facing change is that there is (almost) no [YAML](https://en.wikipedia.org/wiki/YAML), with the definition of inputs and outputs for a report now defined within an R script (`orderly.R`). So an orderly report that previously had an `orderly.yml` file that looked like +The most obvious user-facing change is that there is (almost) no [YAML](https://en.wikipedia.org/wiki/YAML), with the definition of inputs and outputs for a report now defined within an orderly file, `.R`. So an orderly report that previously had an `orderly.yml` file that looked like ```yaml parameters: @@ -39,7 +39,7 @@ artefacts: filenames: data.rds ``` -would end up within an `orderly.R` script that looks like: +would end up within an orderly file that looks like: ```r orderly2::orderly_parameters(n_min = 10) @@ -110,7 +110,7 @@ There are two parts to a migration: updating the canonical copy of your orderly You should migrate your archive first. Do this for every archive that you want to retain (you might have archives stored locally, on production servers and on staging servers). Archive migration happens *out of place*; that is, we do not modify anything in the original location. If your archive is old and has been used with very old versions of `orderly1` it is possible that this process will have a few hiccups. Please let us know if that is the case. The result of this process is that you will end up with a new directory that contains a new archive conforming to the `outpack` spec and containing `orderly2` metadata. -Next, migrate your source tree. This will be done *in place* so should be done on a fresh clone of your source git repository. For each report, we will examine your `orderly.yml` files and your script files (often `script.R`), delete these, and then write out a new `orderly.R` file that will adapt your report to work for `orderly2`. It is possible that this will not be perfect and might need some minor tweaking but hopefully it will be reasonable. One thing that is not preserved (and we probably cannot do so) is the comments from the `yaml` but as these often refer to `yaml` formatting or `orderly1` features hopefully this is not too much of a problem. You will probably want to manually tweak the generated code anyway, to take advantage of some of the new `orderly2` features such as being able to compute dependencies. +Next, migrate your source tree. This will be done *in place* so should be done on a fresh clone of your source git repository. For each report, we will examine your `orderly.yml` files and your script files (often `script.R`), delete these, and then write out a new orderly file that will adapt your report to work for `orderly2`. It is possible that this will not be perfect and might need some minor tweaking but hopefully it will be reasonable. One thing that is not preserved (and we probably cannot do so) is the comments from the `yaml` but as these often refer to `yaml` formatting or `orderly1` features hopefully this is not too much of a problem. You will probably want to manually tweak the generated code anyway, to take advantage of some of the new `orderly2` features such as being able to compute dependencies. If you are using OrderlyWeb, you probably need to pause before migrating, as the replacement is not yet ready. diff --git a/vignettes/plugins.Rmd b/vignettes/plugins.Rmd index fc10450b..10a954e4 100644 --- a/vignettes/plugins.Rmd +++ b/vignettes/plugins.Rmd @@ -34,7 +34,7 @@ With the yaml-less design of `orderly2` (see `vignette("migrating")` if you are As an example, we'll implement a stripped down version of the database plugin that inspired this work (see [`orderly.db](https://github.com/mrc-ide/orderly.db) for a fuller implementation). To make this work we need functions: * ...that process additional fields in `orderly_config.yml` that describe where to find the database -* ...that can be called from `orderly.R` that access the database +* ...that can be called from an orderly file that access the database * ...that can add metadata to the final orderly metadata about what was done We'll start with the report side of things, describing what we want to happen, then work on the implementation. @@ -64,7 +64,7 @@ writeLines(c( 'orderly2::orderly_artefact("Summary of data", "data.rds")', "", 'saveRDS(summary(dat), "data.rds")'), - file.path(path_example, "orderly.R")) + file.path(path_example, "example.R")) update_package <- function(key, path_pkg) { code <- unname(Filter( @@ -90,10 +90,10 @@ yaml_output(readLines(file.path(path_root, "orderly_config.yml"))) Our plugin is called `example.db` and is listed within the `plugins` section, along with its configuration; in this case indicating the path where the SQLite file can be loaded from. -The `orderly.R` file contains information about use of the database for this specific report; in this case, making the results of the query `SELECT * from mtcars WHERE cyl == 4` against the database available as some R object `dat` +The `example.R` file contains information about use of the database for this specific report; in this case, making the results of the query `SELECT * from mtcars WHERE cyl == 4` against the database available as some R object `dat` ```{r, echo = FALSE, results = "asis"} -r_output(readLines(file.path(path_example, "orderly.R"))) +r_output(readLines(file.path(path_example, "example.R"))) ``` Normally, we imagine some calculation here but this is kept minimal for the purpose of demonstration. @@ -102,7 +102,7 @@ To implement this we need to: 1. create a package 2. write a function to handle the configuration in `orderly_config.yml` -3. write a function `query()` used in `orderly.R` to do the query itself +3. write a function `query()` used in `example.R` to do the query itself ### Create a tiny package