From c42db41a87fe211abec15a9fde02f755740ba217 Mon Sep 17 00:00:00 2001 From: Nicholas Masel Date: Thu, 10 Jul 2025 16:43:37 -0400 Subject: [PATCH 1/2] source to global, remove attach --- NAMESPACE | 2 +- R/autos.R | 174 +++++++----------- R/paths.R | 4 + man/envsetup_environment.Rd | 16 ++ man/library.Rd | 77 -------- tests/testthat/_snaps/R4.2/autos.new.md | 7 + tests/testthat/_snaps/R4.2/init.new.md | 57 ++++++ tests/testthat/_snaps/R4.4/autos.md | 89 +++++++++ tests/testthat/_snaps/autos.md | 34 ++++ .../man/testdir/DEV/functions/conflicts.R | 7 + .../man/testdir/PROD/functions/conflicts.R | 7 + .../man/testdir/QA/functions/conflicts.R | 7 + tests/testthat/test-autos.R | 102 ++++++---- 13 files changed, 369 insertions(+), 214 deletions(-) create mode 100644 man/envsetup_environment.Rd delete mode 100644 man/library.Rd create mode 100644 tests/testthat/_snaps/R4.2/autos.new.md create mode 100644 tests/testthat/_snaps/R4.2/init.new.md create mode 100644 tests/testthat/_snaps/autos.md create mode 100644 tests/testthat/man/testdir/DEV/functions/conflicts.R create mode 100644 tests/testthat/man/testdir/PROD/functions/conflicts.R create mode 100644 tests/testthat/man/testdir/QA/functions/conflicts.R diff --git a/NAMESPACE b/NAMESPACE index d2363d1..df3a59d 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -2,8 +2,8 @@ export(build_from_config) export(detach_autos) +export(envsetup_environment) export(init) -export(library) export(read_path) export(rprofile) export(validate_config) diff --git a/R/autos.R b/R/autos.R index 286b79b..06de198 100644 --- a/R/autos.R +++ b/R/autos.R @@ -79,17 +79,76 @@ set_autos <- function(autos, envsetup_environ = Sys.getenv("ENVSETUP_ENVIRON")) # If there are any existing autos then reset them detach_autos() - # Now attach everything. Note that attach will put an environment behind - # global and in front of the package namespaces. By reversing the list, - # the search path will be set to apply the autos to the name space so that - # the path at element one of the list is directly behind global + # Now source everything walk2( - rev(flattened_paths), - rev(names(flattened_paths)), + flattened_paths, + names(flattened_paths), ~ attach_auto(.x, .y) ) } +#' Source scripts and warn of conflicts +#' +#' Source a script, only adding objects to global if they do not already exist +#' +#' @param file path to a script containing object to add to global +#' +#' @return Called for side-effects. Objects are added to the global environment. +#' +#' @noRd +source_warn_conflicts <- function(file){ + + # create a new environment to source into + new_env <- new.env() + + # source directory into a this environment + sys.source(file, + envir = new_env) + + # compare objects to find unique and non-unique + objects_in_new_env <- ls(new_env) + objects_in_global <- ls(.GlobalEnv) + unique_objects <- setdiff(objects_in_new_env, objects_in_global) + non_unique_objects <- intersect(objects_in_new_env, objects_in_global) + + + for (obj_name in unique_objects) { + # move objects from new env to .GlobalEnv + assign(obj_name, base::get(obj_name, envir = new_env), envir = .GlobalEnv) + + # store the metadata for the objects + new_record <- data.frame( + object_name = obj_name, + script = file + ) + + if (!is.null(envsetup_environment$object_metadata)) { + envsetup_environment$object_metadata <- rbind(envsetup_environment$object_metadata, new_record) + } else { + envsetup_environment$object_metadata <- new_record + } + + } + + cat("Sourcing file: ", usethis::ui_value(file), "\n") + + if (length(unique_objects) != 0) { + cat("\n The following objects are added to .GlobalEnv:", sep = "\n") + cat("", sep = "\n") + cat(paste0(" ", usethis::ui_value(unique_objects), "\n")) + } + + + if (length(non_unique_objects) != 0) { + cat("\n The following objects were not added to .GlobalEnv as they already exist:", sep = "\n") + cat("", sep = "\n") + cat(paste0(" ", usethis::ui_value(non_unique_objects), "\n")) + } + + cat("", sep = "\n") + +} + #' Source order of functions #' #' This function is used to define the sorting order of functions if @@ -129,6 +188,7 @@ collate_func <- function(path){ #' #' @return Called for side-effects. Directory paths of the R autos added to search path are printed. attach_auto <- function(path, name) { + name_with_prefix <- paste0("autos:", name) if (!(dir.exists(path) || file.exists(path))) { @@ -137,18 +197,12 @@ attach_auto <- function(path, name) { call. = FALSE) } else if (file.exists(path) && !dir.exists(path)) { # if file, source it - sys.source(path, envir = attach(NULL, name = name_with_prefix)) - - message("Attaching functions from ", path, " to ", name_with_prefix) + source_warn_conflicts(path) } else { collated_r_scripts <- collate_func(path) if (!identical(collated_r_scripts, character(0))) { - walk(collated_r_scripts, - sys.source, - envir = attach(NULL, name = name_with_prefix) - ) - message("Attaching functions from ", path, " to ", name_with_prefix) + walk(collated_r_scripts, source_warn_conflicts) } else { message("No files found in ", path, ". Nothing to attach.") } @@ -224,95 +278,9 @@ attach_auto <- function(path, name) { #' # remove autos from search #' detach_autos() detach_autos <- function() { - in_search <- search()[grepl("^autos:", search())] - # Walk the list of autos and detach them - walk( - in_search, - detach, - character.only = TRUE - ) -} + rm(list = envsetup_environment$object_metadata$object_name, envir = .GlobalEnv) + + envsetup_environment$object_metadata <- NULL -#' Wrapper around library to place packages after any current autos -#' -#' Autos need to immediately follow the global environment. -#' This wrapper around `base::library()` will position any -#' attached packages in the earliest position on the -#' search path currently occupied by a package environment, -#' guaranteeing newly loaded packages appear before previously -#' loaded packages but after any currently attached non-packages. -#' -#' @usage NULL -#' @param ... pass directly through to base::library -#' @param pos see base::library. NULL (the default) is taken -#' to mean the earliest position of a package environment -#' within the current search path. If non-null, underlying -#' behavior of base::library is respected. -#' -#' @return returns (invisibly) the list of attached packages -#' @export -#' -#' @examples -#' # Simple example -#' library(purrr) -#' -#' # Illustrative example to show that autos will always remain above attached libraries -#' tmpdir <- tempdir() -#' print(tmpdir) -#' -#' # account for windows -#' if (Sys.info()['sysname'] == "Windows") { -#' tmpdir <- gsub("\\", "\\\\", tmpdir, fixed = TRUE) -#' } -#' -#' # Create an example config file -#' hierarchy <- paste0("default: -#' paths: -#' functions: !expr list( -#' DEV = file.path('",tmpdir,"', 'demo', 'DEV', 'username', 'project1', 'functions'), -#' PROD = file.path('",tmpdir,"', 'demo', 'PROD', 'project1', 'functions')) -#' autos: -#' my_functions: !expr list( -#' DEV = file.path('",tmpdir,"', 'demo', 'DEV', 'username', 'project1', 'functions'), -#' PROD = file.path('",tmpdir,"', 'demo', 'PROD', 'project1', 'functions'))") -#' -#' -#' # write config -#' writeLines(hierarchy, file.path(tmpdir, "hierarchy.yml")) -#' -#' config <- config::get(file = file.path(tmpdir, "hierarchy.yml")) -#' -#' build_from_config(config) -#' -#' # write function to DEV -#' writeLines("dev_function <- function() {print(environment(dev_function))}", -#' file.path(tmpdir, 'demo/DEV/username/project1/functions/dev_function.r')) -#' -#' # write function to PROD -#' writeLines("prod_function <- function() {print(environment(prod_function))}", -#' file.path(tmpdir, 'demo/PROD/project1/functions/prod_function.r')) -#' -#' # setup the environment -#' Sys.setenv(ENVSETUP_ENVIRON = "DEV") -#' rprofile(config::get(file = file.path(tmpdir, "hierarchy.yml"))) -#' -#' # show search -#' search() -#' -#' # now attach purrr -#' library(purrr) -#' -#' # see autos are still above purrr in the search path -#' search() -library <- function(..., pos = NULL) { - if (is.null(pos)) { - ## we have at least one package loaded (envsetup itself) - ## use earliest current package position as place to - ## attach all future packages, regardless of what - ## envsetup, devtools, or anything else has put - ## in front of them - pos <- min(grep("^package:", search())) - } - base::library(..., pos = pos) } diff --git a/R/paths.R b/R/paths.R index 241cca3..d41fae2 100644 --- a/R/paths.R +++ b/R/paths.R @@ -1,3 +1,7 @@ +#' Path environment +#' @export +envsetup_environment <- new.env() + #' Read path #' #' Check each environment for the file and return the path to the first. diff --git a/man/envsetup_environment.Rd b/man/envsetup_environment.Rd new file mode 100644 index 0000000..77ffb3c --- /dev/null +++ b/man/envsetup_environment.Rd @@ -0,0 +1,16 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/paths.R +\docType{data} +\name{envsetup_environment} +\alias{envsetup_environment} +\title{Path environment} +\format{ +An object of class \code{environment} of length 0. +} +\usage{ +envsetup_environment +} +\description{ +Path environment +} +\keyword{datasets} diff --git a/man/library.Rd b/man/library.Rd deleted file mode 100644 index eb29f76..0000000 --- a/man/library.Rd +++ /dev/null @@ -1,77 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/autos.R -\name{library} -\alias{library} -\title{Wrapper around library to place packages after any current autos} -\arguments{ -\item{...}{pass directly through to base::library} - -\item{pos}{see base::library. NULL (the default) is taken -to mean the earliest position of a package environment -within the current search path. If non-null, underlying -behavior of base::library is respected.} -} -\value{ -returns (invisibly) the list of attached packages -} -\description{ -Autos need to immediately follow the global environment. -This wrapper around \code{base::library()} will position any -attached packages in the earliest position on the -search path currently occupied by a package environment, -guaranteeing newly loaded packages appear before previously -loaded packages but after any currently attached non-packages. -} -\examples{ -# Simple example -library(purrr) - -# Illustrative example to show that autos will always remain above attached libraries -tmpdir <- tempdir() -print(tmpdir) - -# account for windows -if (Sys.info()['sysname'] == "Windows") { - tmpdir <- gsub("\\\\", "\\\\\\\\", tmpdir, fixed = TRUE) -} - -# Create an example config file -hierarchy <- paste0("default: - paths: - functions: !expr list( - DEV = file.path('",tmpdir,"', 'demo', 'DEV', 'username', 'project1', 'functions'), - PROD = file.path('",tmpdir,"', 'demo', 'PROD', 'project1', 'functions')) - autos: - my_functions: !expr list( - DEV = file.path('",tmpdir,"', 'demo', 'DEV', 'username', 'project1', 'functions'), - PROD = file.path('",tmpdir,"', 'demo', 'PROD', 'project1', 'functions'))") - - -# write config -writeLines(hierarchy, file.path(tmpdir, "hierarchy.yml")) - -config <- config::get(file = file.path(tmpdir, "hierarchy.yml")) - -build_from_config(config) - -# write function to DEV -writeLines("dev_function <- function() {print(environment(dev_function))}", - file.path(tmpdir, 'demo/DEV/username/project1/functions/dev_function.r')) - -# write function to PROD -writeLines("prod_function <- function() {print(environment(prod_function))}", - file.path(tmpdir, 'demo/PROD/project1/functions/prod_function.r')) - -# setup the environment -Sys.setenv(ENVSETUP_ENVIRON = "DEV") -rprofile(config::get(file = file.path(tmpdir, "hierarchy.yml"))) - -# show search -search() - -# now attach purrr -library(purrr) - -# see autos are still above purrr in the search path -search() -} diff --git a/tests/testthat/_snaps/R4.2/autos.new.md b/tests/testthat/_snaps/R4.2/autos.new.md new file mode 100644 index 0000000..8797947 --- /dev/null +++ b/tests/testthat/_snaps/R4.2/autos.new.md @@ -0,0 +1,7 @@ +# Autos warns user when ENVSETUP_ENVIRON does not match named environments in autos + + Code + suppressMessages(rprofile(custom_name)) + Warning + The projects autos has named environments DEV, QA, PROD that do not match with the envsetup_environ parameter or ENVSETUP_ENVIRON environment variable bad_name + diff --git a/tests/testthat/_snaps/R4.2/init.new.md b/tests/testthat/_snaps/R4.2/init.new.md new file mode 100644 index 0000000..8773ae3 --- /dev/null +++ b/tests/testthat/_snaps/R4.2/init.new.md @@ -0,0 +1,57 @@ +# init creates a .Rprofile + + Code + init(init_tmpdir, config_path, create_paths = FALSE) + Message + v Configuration file found! + i The following paths in your configuration do not exist: + /DEV/username/project1/data + /PROD/project1/data + /DEV/username/project1/programs + /PROD/project1/programs + /DEV/username/project1/functions + /PROD/project1/functions + /DEV/username/project1/output + /PROD/project1/output + i All path objects will not work since directories are missing. + v .Rprofile created + v envsetup initialization complete + +# init initializes an .Rprofile correcty when one does not exist + + Code + init(init_tmpdir, config_path, create_paths = FALSE) + Message + v Configuration file found! + i The following paths in your configuration do not exist: + /DEV/username/project1/data + /PROD/project1/data + /DEV/username/project1/programs + /PROD/project1/programs + /DEV/username/project1/functions + /PROD/project1/functions + /DEV/username/project1/output + /PROD/project1/output + i All path objects will not work since directories are missing. + v .Rprofile created + v envsetup initialization complete + +# init initializes an .Rprofile correcty when one does exist + + Code + init(init_tmpdir, config_path, create_paths = FALSE) + Message + v Configuration file found! + i The following paths in your configuration do not exist: + /DEV/username/project1/data + /PROD/project1/data + /DEV/username/project1/programs + /PROD/project1/programs + /DEV/username/project1/functions + /PROD/project1/functions + /DEV/username/project1/output + /PROD/project1/output + i All path objects will not work since directories are missing. + v .Rprofile updated + v envsetup initialization complete + diff --git a/tests/testthat/_snaps/R4.4/autos.md b/tests/testthat/_snaps/R4.4/autos.md index 018ac22..c4a49a5 100644 --- a/tests/testthat/_snaps/R4.4/autos.md +++ b/tests/testthat/_snaps/R4.4/autos.md @@ -5,4 +5,93 @@ Condition Warning: The projects autos has named environments DEV, QA, PROD that do not match with the envsetup_environ parameter or ENVSETUP_ENVIRON environment variable bad_name + Output + + The following objects are added to .GlobalEnv: + + 'test_dev' + + + The following objects are added to .GlobalEnv: + + 'my_conflict', 'not_a_conflict_dev' + + + The following objects are added to .GlobalEnv: + + 'inc3' + + + The following objects are added to .GlobalEnv: + + 'inc2' + + + The following objects are added to .GlobalEnv: + + 'inc1' + + + The following objects are added to .GlobalEnv: + + 'mtcars', 'paste', 'test_qa' + + + The following objects are added to .GlobalEnv: + + 'not_a_conflict_qa' + + The following objects were not added to .GlobalEnv as they already exist: + + 'my_conflict' + + + The following objects were not added to .GlobalEnv as they already exist: + + 'inc1' + + + The following objects were not added to .GlobalEnv as they already exist: + + 'inc2' + + + The following objects were not added to .GlobalEnv as they already exist: + + 'inc3' + + + The following objects are added to .GlobalEnv: + + 'not_a_conflict_prod' + + The following objects were not added to .GlobalEnv as they already exist: + + 'my_conflict' + + + The following objects are added to .GlobalEnv: + + 'atest' + + + The following objects are added to .GlobalEnv: + + 'test_prod' + + + The following objects are added to .GlobalEnv: + + 'test_prod2' + + + The following objects are added to .GlobalEnv: + + 'test_global' + + + The following objects were not added to .GlobalEnv as they already exist: + + 'atest' + diff --git a/tests/testthat/_snaps/autos.md b/tests/testthat/_snaps/autos.md new file mode 100644 index 0000000..6970f3b --- /dev/null +++ b/tests/testthat/_snaps/autos.md @@ -0,0 +1,34 @@ +# source_warn_conflicts works with one directory + + Code + source_warn_conflicts(dirs) + Output + + The following objects are added to .GlobalEnv: + + 'my_conflict', 'not_a_conflict_dev' + + +--- + + Code + envsetup_environment$object_metadata$object_name + Output + [1] "test_global" "atest" "my_conflict" + [4] "not_a_conflict_dev" + +# source_warn_conflicts works when adding a second directory with conflicts + + Code + source_warn_conflicts(dirs[[2]]) + Output + + The following objects are added to .GlobalEnv: + + 'not_a_conflict_qa' + + The following objects were not added to .GlobalEnv as they already exist: + + 'my_conflict' + + diff --git a/tests/testthat/man/testdir/DEV/functions/conflicts.R b/tests/testthat/man/testdir/DEV/functions/conflicts.R new file mode 100644 index 0000000..eaf33f9 --- /dev/null +++ b/tests/testthat/man/testdir/DEV/functions/conflicts.R @@ -0,0 +1,7 @@ +my_conflict <- function(){ + print("This is a function that makes a conflict. It is in DEV.") +} + +not_a_conflict_dev <- function(){ + print("This function does not cause a conflict. It is in DEV.") +} diff --git a/tests/testthat/man/testdir/PROD/functions/conflicts.R b/tests/testthat/man/testdir/PROD/functions/conflicts.R new file mode 100644 index 0000000..f73b1a8 --- /dev/null +++ b/tests/testthat/man/testdir/PROD/functions/conflicts.R @@ -0,0 +1,7 @@ +my_conflict <- function(){ + print("This is a function that makes a conflict. It is in PROD.") +} + +not_a_conflict_prod <- function(){ + print("This function does not cause a conflict. It is in PROD.") +} diff --git a/tests/testthat/man/testdir/QA/functions/conflicts.R b/tests/testthat/man/testdir/QA/functions/conflicts.R new file mode 100644 index 0000000..3c2c171 --- /dev/null +++ b/tests/testthat/man/testdir/QA/functions/conflicts.R @@ -0,0 +1,7 @@ +my_conflict <- function(){ + print("This is a function that makes a conflict. It is in QA.") +} + +not_a_conflict_qa <- function(){ + print("This function does not cause a conflict. It is in QA.") +} diff --git a/tests/testthat/test-autos.R b/tests/testthat/test-autos.R index 7597ad2..6de13b7 100644 --- a/tests/testthat/test-autos.R +++ b/tests/testthat/test-autos.R @@ -14,6 +14,11 @@ custom_name <- config::get( file = testthat::test_path("man/_envsetup_testthat.yml") ) +remove_sourcing_file <- function(x) { + # Use regular expressions to remove the line containing "Sourcing file" + x[!grepl("^Sourcing file:", x)] +} + # Dev tests Sys.setenv(ENVSETUP_ENVIRON = "DEV") @@ -23,15 +28,18 @@ test_that("Autos set and test_dev from highest level appears correctly", { suppressMessages(set_autos(custom_name$autos)) expect_equal(c(test_dev()), c("Test of dev autos")) expect_equal(c(test_global()), c("Test of global autos")) + + detach_autos() }) #' @editor Nick Masel -#' @editDate 2024-12-30 +#' @editDate 2025-07-10 test_that("Order of functions appears correctly when @include is used", { dev_order <- collate_func(custom_name$autos$projects$DEV) expect_equal(dev_order, c(file.path(tmpdir, "DEV/functions/TestDev.R"), + file.path(tmpdir, "DEV/functions/conflicts.R"), file.path(tmpdir, "DEV/functions/inc3.R"), file.path(tmpdir, "DEV/functions/inc2.R"), file.path(tmpdir, "DEV/functions/inc1.R") @@ -41,11 +49,12 @@ test_that("Order of functions appears correctly when @include is used", { #' @editor Nick Masel -#' @editDate 2024-12-30 +#' @editDate 2025-07-10 test_that("Order of functions appears correctly when @include is not used", { qa_order <- collate_func(custom_name$autos$projects$QA) expect_equal(qa_order, c(file.path(tmpdir, "QA/functions/QATest.R"), + file.path(tmpdir, "QA/functions/conflicts.R"), file.path(tmpdir, "QA/functions/inc1.R"), file.path(tmpdir, "QA/functions/inc2.R"), file.path(tmpdir, "QA/functions/inc3.R") @@ -53,19 +62,6 @@ test_that("Order of functions appears correctly when @include is not used", { ) }) -#' @editor Gabe Becker -#' @editDate 2023-11-22 -test_that("library returns invisibly", { - # Detatch envsetup:paths if it exists - if (any(search() == "envsetup:paths")) { - detach("envsetup:paths") - } - expect_silent(expect_invisible(suppressPackageStartupMessages(library("purrr")))) - suppressMessages(rprofile(custom_name)) - detach("package:purrr") -}) - - #' @editor Aidan Ceney #' @editDate 2022-05-12 test_that("Autos validation from yml happens correctly", { @@ -87,7 +83,6 @@ test_that("Autos validation from yml happens correctly", { }) # Detatch and re-setup for QA now -detach_autos() Sys.setenv(ENVSETUP_ENVIRON = "QA") #' @editor Mike Stackhouse @@ -100,6 +95,8 @@ test_that("Setting environment to QA filters out dev autos", { ) expect_error(test_dev()) expect_equal(c(test_global()), c("Test of global autos")) + + detach_autos() }) #' @editor Mike Stackhouse @@ -107,6 +104,8 @@ test_that("Setting environment to QA filters out dev autos", { test_that("Data output in namespace appears", { suppressMessages(set_autos(custom_name$autos)) expect_equal(mtcars, iris) + + detach_autos() }) #' @editor Mike Stackhouse @@ -120,6 +119,7 @@ test_that("set_autos effectively clears and resets namespace", { suppressMessages(set_autos(custom_name$autos)) expect_error(test_qa()) expect_equal(c(test_global()), c("Test of global autos")) + detach_autos() }) #' @editor Mike Stackhouse @@ -128,6 +128,8 @@ test_that("Functions in higher level hierarchy export and multiple functions may suppressMessages(set_autos(custom_name$autos)) expect_equal(test_prod(), "Test of prod autos") expect_equal(test_prod2(), "Test of prod autos second") + + detach_autos() }) #' @editor Mike Stackhouse @@ -138,31 +140,21 @@ test_that("Autos no longer exist when detached", { expect_error(test_prod()) }) -test_that("the configuration can be named anything and library will - reattach the autos correctly", { - suppressMessages(rprofile(custom_name)) - - expect_invisible(suppressPackageStartupMessages(library("purrr"))) - - purrr_location <- which(search() == "package:purrr") - autos_locatios <- which(grepl("^autos:", search())) - - expect_true(all(purrr_location > autos_locatios)) - detach("package:purrr") - } -) - - +#' @editor Nick Masel +#' @editDate 2025-07-10 test_that("Autos warns user when ENVSETUP_ENVIRON does not match named environments in autos", { withr::local_envvar(ENVSETUP_ENVIRON = "bad_name") - expect_snapshot(suppressMessages(rprofile(custom_name)), variant = r_version()) + expect_snapshot( + suppressMessages(rprofile(custom_name)), + variant = r_version(), + transform = remove_sourcing_file + ) }) #' @editor Nick Masel #' @editDate 2024-10-24 -detach_autos() Sys.setenv(ENVSETUP_ENVIRON = "QA") null_test <- config::get( file = testthat::test_path("man/_envsetup_testthat_null.yml") @@ -170,3 +162,47 @@ null_test <- config::get( test_that("NULL paths do not throw an error", { expect_no_error(set_autos(null_test$autos)) }) + + + +#' @editor Nick Masel +#' @editDate 2025-07-10 +test_that("source_warn_conflicts works with one directory", { + dirs <- testthat::test_path("man/testdir/DEV/functions/conflicts.R") + + expect_snapshot( + source_warn_conflicts(dirs), + transform = remove_sourcing_file + ) + + # check object_metadata + expect_snapshot(envsetup_environment$object_metadata$object_name) +}) + +#' @editor Nick Masel +#' @editDate 2025-07-10 +test_that("source_warn_conflicts works when adding a second directory with conflicts", { + dirs <- list( + testthat::test_path("man/testdir/DEV/functions/conflicts.R"), + testthat::test_path("man/testdir/QA/functions/conflicts.R") + ) + + # source first file + source_warn_conflicts(dirs[[1]]) + + # now source second to confirm functions added, and those not added to global + expect_snapshot( + source_warn_conflicts(dirs[[2]]), + transform = remove_sourcing_file + ) + +}) + +#' @editor Nick Masel +#' @editDate 2025-07-10 +test_that("source_warn_conflicts throws an error when a path is not valid", { + + dirs <- testthat::test_path("man/testdir/DEV/functions/conflictss.R") + expect_error(source_warn_conflicts(dirs)) + +}) From bc7eb087cc395e1104565c911fe3b8952f132ec0 Mon Sep 17 00:00:00 2001 From: Nicholas Masel Date: Tue, 22 Jul 2025 10:20:59 -0400 Subject: [PATCH 2/2] add overwrite arg for autos --- R/autos.R | 108 ++++++++++++++------- R/rprofile.R | 5 +- man/rprofile.Rd | 4 +- tests/testthat/_snaps/R4.4/autos.md | 32 +++++-- tests/testthat/_snaps/autos.md | 11 +-- tests/testthat/test-autos.R | 140 ++++++++++++++++++++++++++-- 6 files changed, 244 insertions(+), 56 deletions(-) diff --git a/R/autos.R b/R/autos.R index 06de198..54f367e 100644 --- a/R/autos.R +++ b/R/autos.R @@ -10,6 +10,7 @@ #' @param envsetup_environ name of the environment you would like to read from; #' default values comes from the value in the system variable ENVSETUP_ENVIRON #' which can be set by Sys.setenv(ENVSETUP_ENVIRON = "environment name") +#' @param overwrite logical indicating if sourcing of autos should overwrite an object in global if it already exists #' #' @return Called for side-effects. Directory paths of the R autos added to search path are printed. #' @@ -17,7 +18,7 @@ #' @importFrom rlang is_named #' @importFrom usethis ui_field #' @noRd -set_autos <- function(autos, envsetup_environ = Sys.getenv("ENVSETUP_ENVIRON")) { +set_autos <- function(autos, envsetup_environ = Sys.getenv("ENVSETUP_ENVIRON"), overwrite = TRUE) { # Must be named list if (!is_named(autos)) { @@ -83,7 +84,7 @@ set_autos <- function(autos, envsetup_environ = Sys.getenv("ENVSETUP_ENVIRON")) walk2( flattened_paths, names(flattened_paths), - ~ attach_auto(.x, .y) + ~ attach_auto(.x, .y, overwrite = overwrite) ) } @@ -92,15 +93,18 @@ set_autos <- function(autos, envsetup_environ = Sys.getenv("ENVSETUP_ENVIRON")) #' Source a script, only adding objects to global if they do not already exist #' #' @param file path to a script containing object to add to global +#' @param overwrite logical indicating if sourcing should overwrite an object in global if it already exists #' #' @return Called for side-effects. Objects are added to the global environment. #' #' @noRd -source_warn_conflicts <- function(file){ +source_warn_conflicts <- function(file, overwrite = TRUE){ # create a new environment to source into new_env <- new.env() + cat("Sourcing file: ", usethis::ui_value(file), "\n") + # source directory into a this environment sys.source(file, envir = new_env) @@ -108,47 +112,85 @@ source_warn_conflicts <- function(file){ # compare objects to find unique and non-unique objects_in_new_env <- ls(new_env) objects_in_global <- ls(.GlobalEnv) - unique_objects <- setdiff(objects_in_new_env, objects_in_global) - non_unique_objects <- intersect(objects_in_new_env, objects_in_global) - - - for (obj_name in unique_objects) { - # move objects from new env to .GlobalEnv - assign(obj_name, base::get(obj_name, envir = new_env), envir = .GlobalEnv) - - # store the metadata for the objects - new_record <- data.frame( - object_name = obj_name, - script = file - ) - - if (!is.null(envsetup_environment$object_metadata)) { - envsetup_environment$object_metadata <- rbind(envsetup_environment$object_metadata, new_record) - } else { - envsetup_environment$object_metadata <- new_record - } + if (overwrite == FALSE) { + objects_to_assign <- setdiff(objects_in_new_env, objects_in_global) + objects_to_skip_assign <- intersect(objects_in_new_env, objects_in_global) + objects_that_are_overwritten <- NULL + } else if (overwrite == TRUE) { + objects_to_assign <- objects_in_new_env + objects_to_skip_assign <- NULL + objects_that_are_overwritten <- intersect(objects_in_new_env, objects_in_global) + } else { + warning("overwrite must contain a logical") } - cat("Sourcing file: ", usethis::ui_value(file), "\n") + for (obj_name in objects_to_assign) { + assign_and_move_function(obj_name, temp_env = new_env, envir = .GlobalEnv) + record_function_metadata(obj_name, file) + } - if (length(unique_objects) != 0) { + if (length(objects_to_assign) != 0) { cat("\n The following objects are added to .GlobalEnv:", sep = "\n") cat("", sep = "\n") - cat(paste0(" ", usethis::ui_value(unique_objects), "\n")) + cat(paste0(" ", usethis::ui_value(objects_to_assign), "\n")) } - if (length(non_unique_objects) != 0) { + if (length(objects_to_skip_assign) != 0) { cat("\n The following objects were not added to .GlobalEnv as they already exist:", sep = "\n") cat("", sep = "\n") - cat(paste0(" ", usethis::ui_value(non_unique_objects), "\n")) + cat(paste0(" ", usethis::ui_value(objects_to_skip_assign), "\n")) + } + + + if (length(objects_that_are_overwritten) != 0) { + cat("\n The following objects were overwritten in .GlobalEnv:", sep = "\n") + cat("", sep = "\n") + cat(paste0(" ", usethis::ui_value(objects_that_are_overwritten), "\n")) } cat("", sep = "\n") } + +assign_and_move_function <- function(obj_name, temp_env, envir){ + assign(obj_name, base::get(obj_name, envir = temp_env), envir = envir) +} + + +record_function_metadata <- function(obj_name, file + # , envir + ){ + + # store the metadata for the objects + new_record <- data.frame( + object_name = obj_name, + script = file + ) + + if (exists("object_metadata", envsetup_environment)) { + df <- dplyr::full_join( + base::get("object_metadata", envsetup_environment), + new_record, + by = dplyr::join_by(object_name)) + + if (any(c("script.x", "script.y") %in% names(df))) { + df$script <- ifelse(is.na(df$script.y), df$script.x, df$script.y) + df$script.x <- NULL + df$script.y <- NULL + } + + # assign("object_metadata", df, envir = envir) + envsetup_environment$object_metadata <- df + } else { + envsetup_environment$object_metadata <- new_record + # assign("object_metadata", new_record, envir = envir) + } + +} + #' Source order of functions #' #' This function is used to define the sorting order of functions if @@ -184,10 +226,11 @@ collate_func <- function(path){ #' #' @param path Directory path #' @param name Directory name +#' @param overwrite logical indicating if sourcing of autos should overwrite an object in global if it already exists #' @noRd #' #' @return Called for side-effects. Directory paths of the R autos added to search path are printed. -attach_auto <- function(path, name) { +attach_auto <- function(path, name, overwrite = TRUE) { name_with_prefix <- paste0("autos:", name) @@ -202,7 +245,7 @@ attach_auto <- function(path, name) { collated_r_scripts <- collate_func(path) if (!identical(collated_r_scripts, character(0))) { - walk(collated_r_scripts, source_warn_conflicts) + walk(collated_r_scripts, source_warn_conflicts, overwrite = overwrite) } else { message("No files found in ", path, ". Nothing to attach.") } @@ -279,8 +322,9 @@ attach_auto <- function(path, name) { #' detach_autos() detach_autos <- function() { - rm(list = envsetup_environment$object_metadata$object_name, envir = .GlobalEnv) - - envsetup_environment$object_metadata <- NULL + if (exists("object_metadata", envir = envsetup_environment)){ + rm(list = envsetup_environment$object_metadata$object_name, envir = .GlobalEnv) + rm("object_metadata", envir = envsetup_environment) + } } diff --git a/R/rprofile.R b/R/rprofile.R index 0084f4b..653b49c 100644 --- a/R/rprofile.R +++ b/R/rprofile.R @@ -1,6 +1,7 @@ #' Function used to pass through code to the .Rprofile #' #' @param config configuration object from config::get() +#' @param overwrite logical indicating if sourcing of autos should overwrite an object in global if it already exists #' @export #' @return Called for its side effects. Directory paths and autos are added to the search path based on your config. #' @@ -22,7 +23,7 @@ #' writeLines(hierarchy, file.path(tmpdir, "hierarchy.yml")) #' #' rprofile(config::get(file = file.path(tmpdir, "hierarchy.yml"))) -rprofile <- function(config) { +rprofile <- function(config, overwrite = TRUE) { if ("envsetup:paths" %in% search()) { detach("envsetup:paths", character.only = TRUE) } @@ -51,6 +52,6 @@ rprofile <- function(config) { # If autos exist, set them if (!is.null(config$autos)) { - set_autos(config$autos) + set_autos(config$autos, overwrite = overwrite) } } diff --git a/man/rprofile.Rd b/man/rprofile.Rd index 3a9a3d3..1de3c31 100644 --- a/man/rprofile.Rd +++ b/man/rprofile.Rd @@ -4,10 +4,12 @@ \alias{rprofile} \title{Function used to pass through code to the .Rprofile} \usage{ -rprofile(config) +rprofile(config, overwrite = TRUE) } \arguments{ \item{config}{configuration object from config::get()} + +\item{overwrite}{logical indicating if sourcing of autos should overwrite an object in global if it already exists} } \value{ Called for its side effects. Directory paths and autos are added to the search path based on your config. diff --git a/tests/testthat/_snaps/R4.4/autos.md b/tests/testthat/_snaps/R4.4/autos.md index c4a49a5..4d3cfc1 100644 --- a/tests/testthat/_snaps/R4.4/autos.md +++ b/tests/testthat/_snaps/R4.4/autos.md @@ -39,33 +39,45 @@ The following objects are added to .GlobalEnv: - 'not_a_conflict_qa' + 'my_conflict', 'not_a_conflict_qa' - The following objects were not added to .GlobalEnv as they already exist: + The following objects were overwritten in .GlobalEnv: 'my_conflict' - The following objects were not added to .GlobalEnv as they already exist: + The following objects are added to .GlobalEnv: + + 'inc1' + + The following objects were overwritten in .GlobalEnv: 'inc1' - The following objects were not added to .GlobalEnv as they already exist: + The following objects are added to .GlobalEnv: + + 'inc2' + + The following objects were overwritten in .GlobalEnv: 'inc2' - The following objects were not added to .GlobalEnv as they already exist: + The following objects are added to .GlobalEnv: + + 'inc3' + + The following objects were overwritten in .GlobalEnv: 'inc3' The following objects are added to .GlobalEnv: - 'not_a_conflict_prod' + 'my_conflict', 'not_a_conflict_prod' - The following objects were not added to .GlobalEnv as they already exist: + The following objects were overwritten in .GlobalEnv: 'my_conflict' @@ -90,7 +102,11 @@ 'test_global' - The following objects were not added to .GlobalEnv as they already exist: + The following objects are added to .GlobalEnv: + + 'atest' + + The following objects were overwritten in .GlobalEnv: 'atest' diff --git a/tests/testthat/_snaps/autos.md b/tests/testthat/_snaps/autos.md index 6970f3b..20d7bcc 100644 --- a/tests/testthat/_snaps/autos.md +++ b/tests/testthat/_snaps/autos.md @@ -1,4 +1,4 @@ -# source_warn_conflicts works with one directory +# source_warn_conflicts works with one directory in global Code source_warn_conflicts(dirs) @@ -14,10 +14,9 @@ Code envsetup_environment$object_metadata$object_name Output - [1] "test_global" "atest" "my_conflict" - [4] "not_a_conflict_dev" + [1] "my_conflict" "not_a_conflict_dev" -# source_warn_conflicts works when adding a second directory with conflicts +# source_warn_conflicts works when adding a second directory with conflicts in global Code source_warn_conflicts(dirs[[2]]) @@ -25,9 +24,9 @@ The following objects are added to .GlobalEnv: - 'not_a_conflict_qa' + 'my_conflict', 'not_a_conflict_qa' - The following objects were not added to .GlobalEnv as they already exist: + The following objects were overwritten in .GlobalEnv: 'my_conflict' diff --git a/tests/testthat/test-autos.R b/tests/testthat/test-autos.R index 6de13b7..558df55 100644 --- a/tests/testthat/test-autos.R +++ b/tests/testthat/test-autos.R @@ -22,13 +22,105 @@ remove_sourcing_file <- function(x) { # Dev tests Sys.setenv(ENVSETUP_ENVIRON = "DEV") -#' @editor Mike Stackhouse -#' @editDate 2023-02-11 -test_that("Autos set and test_dev from highest level appears correctly", { +#' @editor Nick Masel +#' @editDate 2025-07-22 +test_that("Autos set correctly when default of overwrite is used", { suppressMessages(set_autos(custom_name$autos)) + expect_equal(c(test_dev()), c("Test of dev autos")) expect_equal(c(test_global()), c("Test of global autos")) + # my_conflict is in dev, qa and prod. overwrite is TRUE so we should see the prod version. + expect_equal(c(my_conflict()), c("This is a function that makes a conflict. It is in PROD.")) + + # check object metadata stores files correctly + expect_equal( + envsetup_environment$object_metadata, + data.frame( + stringsAsFactors = FALSE, + object_name = c("test_dev", + "my_conflict", + "not_a_conflict_dev", + "inc3", + "inc2", + "inc1", + "mtcars", + "paste", + "test_qa", + "not_a_conflict_qa", + "not_a_conflict_prod", + "atest", + "test_prod", + "test_prod2", + "test_global"), + script = c(file.path(tmpdir, "DEV/functions/TestDev.R"), + file.path(tmpdir, "PROD/functions/conflicts.R"), + file.path(tmpdir, "DEV/functions/conflicts.R"), + file.path(tmpdir, "QA/functions/inc3.R"), + file.path(tmpdir, "QA/functions/inc2.R"), + file.path(tmpdir, "QA/functions/inc1.R"), + file.path(tmpdir, "QA/functions/QATest.R"), + file.path(tmpdir, "QA/functions/QATest.R"), + file.path(tmpdir, "QA/functions/QATest.R"), + file.path(tmpdir, "QA/functions/conflicts.R"), + file.path(tmpdir, "PROD/functions/conflicts.R"), + file.path(tmpdir, "PROD/functions/envre.R"), + file.path(tmpdir, "PROD/functions/prodtest.R"), + file.path(tmpdir, "PROD/functions/prodtest2.R"), + file.path(tmpdir, "global/functions/globaltest.R")) + )) + + detach_autos() +}) + +#' @editor Nick Masel +#' @editDate 2025-07-22 +test_that("Autos set correctly when overwrite is FALSE", { + suppressMessages(set_autos(custom_name$autos, overwrite = FALSE)) + + expect_equal(c(test_dev()), c("Test of dev autos")) + expect_equal(c(test_global()), c("Test of global autos")) + + # my_conflict is in dev, qa and prod. overwrite is FALSE so we should see the dev version. + expect_equal(c(my_conflict()), c("This is a function that makes a conflict. It is in DEV.")) + + # check object metadata stores files correctly + expect_equal( + envsetup_environment$object_metadata, + data.frame( + stringsAsFactors = FALSE, + object_name = c("test_dev", + "my_conflict", + "not_a_conflict_dev", + "inc3", + "inc2", + "inc1", + "mtcars", + "paste", + "test_qa", + "not_a_conflict_qa", + "not_a_conflict_prod", + "atest", + "test_prod", + "test_prod2", + "test_global"), + script = c(file.path(tmpdir, "DEV/functions/TestDev.R"), + file.path(tmpdir, "DEV/functions/conflicts.R"), + file.path(tmpdir, "DEV/functions/conflicts.R"), + file.path(tmpdir, "DEV/functions/inc3.R"), + file.path(tmpdir, "DEV/functions/inc2.R"), + file.path(tmpdir, "DEV/functions/inc1.R"), + file.path(tmpdir, "QA/functions/QATest.R"), + file.path(tmpdir, "QA/functions/QATest.R"), + file.path(tmpdir, "QA/functions/QATest.R"), + file.path(tmpdir, "QA/functions/conflicts.R"), + file.path(tmpdir, "PROD/functions/conflicts.R"), + file.path(tmpdir, "PROD/functions/envre.R"), + file.path(tmpdir, "PROD/functions/prodtest.R"), + file.path(tmpdir, "PROD/functions/prodtest2.R"), + file.path(tmpdir, "global/functions/globaltest.R")) + )) + detach_autos() }) @@ -110,7 +202,9 @@ test_that("Data output in namespace appears", { #' @editor Mike Stackhouse #' @editDate 2022-02-11 -test_that("set_autos effectively clears and resets namespace", { +test_that("set_autos effectively clears previously sourced autos", { + Sys.setenv(ENVSETUP_ENVIRON = "DEV") + suppressMessages(set_autos(custom_name$autos)) Sys.setenv(ENVSETUP_ENVIRON = "QA") suppressMessages(set_autos(custom_name$autos)) expect_error(test_dev()) @@ -150,6 +244,8 @@ test_that("Autos warns user when ENVSETUP_ENVIRON does not match named environme variant = r_version(), transform = remove_sourcing_file ) + + detach_autos() }) @@ -161,13 +257,15 @@ null_test <- config::get( ) test_that("NULL paths do not throw an error", { expect_no_error(set_autos(null_test$autos)) + + detach_autos() }) #' @editor Nick Masel #' @editDate 2025-07-10 -test_that("source_warn_conflicts works with one directory", { +test_that("source_warn_conflicts works with one directory in global", { dirs <- testthat::test_path("man/testdir/DEV/functions/conflicts.R") expect_snapshot( @@ -177,11 +275,14 @@ test_that("source_warn_conflicts works with one directory", { # check object_metadata expect_snapshot(envsetup_environment$object_metadata$object_name) + + detach_autos() }) #' @editor Nick Masel #' @editDate 2025-07-10 -test_that("source_warn_conflicts works when adding a second directory with conflicts", { +test_that("source_warn_conflicts works when adding a second directory with conflicts in global", { + dirs <- list( testthat::test_path("man/testdir/DEV/functions/conflicts.R"), testthat::test_path("man/testdir/QA/functions/conflicts.R") @@ -190,19 +291,44 @@ test_that("source_warn_conflicts works when adding a second directory with confl # source first file source_warn_conflicts(dirs[[1]]) + expect_equal( + envsetup_environment$object_metadata, + data.frame( + stringsAsFactors = FALSE, + object_name = c("my_conflict", "not_a_conflict_dev"), + script = c(dirs[[1]], + dirs[[1]]) + ) + ) + # now source second to confirm functions added, and those not added to global expect_snapshot( source_warn_conflicts(dirs[[2]]), transform = remove_sourcing_file ) + expect_equal( + envsetup_environment$object_metadata, + data.frame( + stringsAsFactors = FALSE, + object_name = c("my_conflict", "not_a_conflict_dev", "not_a_conflict_qa"), + script = c(dirs[[2]], + dirs[[1]], + dirs[[2]]) + ) + ) + + detach_autos() + }) #' @editor Nick Masel #' @editDate 2025-07-10 -test_that("source_warn_conflicts throws an error when a path is not valid", { +test_that("source_warn_conflicts throws an error when a path is not valid in global", { dirs <- testthat::test_path("man/testdir/DEV/functions/conflictss.R") expect_error(source_warn_conflicts(dirs)) + detach_autos() + })