From 3cd68c3972bab42f40c81acdf2f21bd820503585 Mon Sep 17 00:00:00 2001
From: Pascal Sauer <pascal.sauer@pik-potsdam.de>
Date: Wed, 24 Jan 2024 15:35:11 +0100
Subject: [PATCH] redirect scope

---
 R/localRedirect.R                   |  7 ++++---
 tests/testthat/test-localRedirect.R | 14 ++++++++++++++
 2 files changed, 18 insertions(+), 3 deletions(-)

diff --git a/R/localRedirect.R b/R/localRedirect.R
index 80ae6d9..9e6bdd2 100644
--- a/R/localRedirect.R
+++ b/R/localRedirect.R
@@ -10,6 +10,8 @@
 #' a potential later implementation of subtype redirections.
 #' @param ... Additional arguments, passed on to source-specific inject function if it exists
 #' @param target Path to the new source folder, NULL to remove the redirection
+#' @param .local The scope of the redirection, passed on to setConfig. Defaults to the current function.
+#' Set to FALSE for a permanent global redirection.
 #' @return Invisibly, a list of all redirections where names are types and
 #' values are the paths these types are redirected to.
 #' @author Pascal Sauer
@@ -26,7 +28,7 @@
 #' readSource("Tau")
 #' }
 #' @export
-localRedirect <- function(type, subtype = NULL, ..., target) {
+localRedirect <- function(type, subtype = NULL, ..., target, .local = parent.frame()) {
   # Redirecting only specific subtypes is not supported to avoid tricky cases
   # where the subtype is ignored (search for "getSourceFolder\(.*subtype = NULL\)").
 
@@ -39,7 +41,6 @@ localRedirect <- function(type, subtype = NULL, ..., target) {
 
   redirections <- getConfig("redirections")
   redirections[[type]] <- target
-  # TODO allow other scopes, e.g. global or parent.frame(2)
-  setConfig(redirections = redirections, .local = parent.frame())
+  setConfig(redirections = redirections, .local = .local)
   return(invisible(redirections))
 }
diff --git a/tests/testthat/test-localRedirect.R b/tests/testthat/test-localRedirect.R
index 6370acd..a53dded 100644
--- a/tests/testthat/test-localRedirect.R
+++ b/tests/testthat/test-localRedirect.R
@@ -30,3 +30,17 @@ test_that("localRedirect works", {
   localRedirect("Example", target = "Example2")
   expect_identical(as.vector(readSource("Example")), 456)
 })
+
+test_that("scope for localRedirect can be set", {
+  localConfig(redirections = list())
+  withr::local_dir(withr::local_tempdir())
+  dir.create("tau2")
+  dir.create("tau3")
+
+  f1 <- function() {
+    localRedirect("tau", target = "tau2")
+    expect_identical(getConfig("redirections"), list(tau = normalizePath("tau2")))
+  }
+  f()
+  expect_identical(getConfig("redirections"), list())
+})