From 53fd56c15b99e0a1ed9d706e560fdd2e8ccc4604 Mon Sep 17 00:00:00 2001
From: asardaes <alexis.sarda@gmail.com>
Date: Sat, 22 Jun 2024 22:40:08 +0200
Subject: [PATCH] Refactor quoted_call to use do_call

---
 NAMESPACE                          |  4 ++++
 R/CLUSTERING-compare-clusterings.R |  4 ++--
 R/UTILS-utils.R                    | 10 +++++-----
 3 files changed, 11 insertions(+), 7 deletions(-)

diff --git a/NAMESPACE b/NAMESPACE
index c89a72a4..f03232a2 100644
--- 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
index d61c599d..96b0661b 100644
--- 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
index 7d5a1789..ca3bbe65 100644
--- 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)
 }