Refactor quoted_call to use do_call

asardaes · Jun 22, 2024 · 53fd56c · 53fd56c
1 parent d0282a1
commit 53fd56c
Show file tree

Hide file tree

Showing 3 changed files with 11 additions and 7 deletions.
diff --git a/NAMESPACE b/NAMESPACE
@@ -124,8 +124,12 @@ importFrom(proxy,pr_DB)
 importFrom(reshape2,melt)
 importFrom(rlang,"!!!")
 importFrom(rlang,.data)
+importFrom(rlang,as_environment)
 importFrom(rlang,enexprs)
+importFrom(rlang,env_bind)
+importFrom(rlang,exprs)
 importFrom(rlang,list2)
+importFrom(rlang,syms)
 importFrom(shiny,runApp)
 importFrom(shiny,shinyApp)
 importFrom(shinyjs,useShinyjs)

diff --git a/R/CLUSTERING-compare-clusterings.R b/R/CLUSTERING-compare-clusterings.R
@@ -62,7 +62,7 @@ pdc_configs <- function(type = c("preproc", "distance", "centroid"), ...,
     if (length(shared) > 0L && length(share.config) > 0L) {
         # careful, singular and plural below
         shared_cfg <- Map(shared, names(shared), f = function(shared_args, fun) {
-            cfg <- quoted_call(expand.grid, foo = fun, stringsAsFactors = FALSE, dots = shared_args)
+            cfg <- quoted_call(expand.grid, fun, stringsAsFactors = FALSE, dots = shared_args)
             names(cfg)[1L] <- type
             cfg
         })
@@ -86,7 +86,7 @@ pdc_configs <- function(type = c("preproc", "distance", "centroid"), ...,
             if (!is.list(config) || is.null(config_names))
                 stop("All parameters must be named lists.") # nocov
             cfg <- Map(config, config_names, f = function(config_args, fun) {
-                cfg <- quoted_call(expand.grid, foo = fun, stringsAsFactors = FALSE, dots = config_args)
+                cfg <- quoted_call(expand.grid, fun, stringsAsFactors = FALSE, dots = config_args)
                 names(cfg)[1L] <- type
                 cfg
             })

diff --git a/R/UTILS-utils.R b/R/UTILS-utils.R
@@ -136,9 +136,10 @@ get_from_callers <- function(obj_name, mode = "any") {
     stop("Could not find object '", obj_name, "' of mode '", mode, "'") # nocov
 }
 
-# do.call but always quoted
+#' @importFrom rlang as_environment
 quoted_call <- function(fun, ..., dots = NULL) {
-    do.call(fun, enlist(..., dots = dots), quote = TRUE)
+    parent <- rlang::as_environment(list(.fun_ = match.fun(fun)), parent = parent.frame())
+    do_call(".fun_", enlist(..., dots = dots), parent = parent)
 }
 
 #' @importFrom rlang as_environment
@@ -169,8 +170,7 @@ call_rbind <- function(args) {
 
 #' @importFrom rlang as_environment
 #' @importFrom rlang syms
-do_call <- function(f, args, dots = NULL) {
-    args <- c(args, dots)
+do_call <- function(f, args, parent = parent.frame()) {
     original_names <- tmp_names <- names(args)
     unnamed <- tmp_names == ""
 
@@ -187,7 +187,7 @@ do_call <- function(f, args, dots = NULL) {
         names(tmp_names) <- original_names
     }
 
-    envir <- rlang::as_environment(args, parent.frame())
+    envir <- rlang::as_environment(args, parent)
     do.call(f, rlang::syms(tmp_names), envir = envir)
 }