I am in the following situation:
some_env) that stores a list of functions (such as some_function()). Note that I don’t own this environment, it is imported from another packagelibrary(rlang)
# Define a custom environment where I store a function.
# This is done in another package.
some_env <- new.env(parent = emptyenv())
class(some_env) <- "custom_class"
some_env$some_function <- function(x) {
print(x)
}
# Make a user-facing function that calls the function stored in the custom
# environment under the hood
user_facing_fn <- function(val = 1) {
some_env$some_function(val)
}
user_facing_fn()
#> [1] 1
My objective is to capture the call to this internal function (some_function()). I could do this inside user_facing_fn() using rlang::expr() and !!. However, in the real situation, I have many user-facing functions so using this combination would greatly clutter the code.
Therefore, I thought about defining a custom class and $ call so that I can access the call before dispatching it to the next method.
# Define a custom `$` to access the call before evaluating it
`$.custom_class` <- function(x, name) {
fc <- rlang::frame_call()
### For debugging
cat("----------------\n")
print(fc)
cat("----------------\n")
print(str(fc))
cat("----------------\n")
print(deparse(fc))
###
NextMethod("$") # <<<<<<<<<<<<< Not interested in this part
}
It seems that I can capture the call with frame_call() and it is correctly printed (see the first printed line below):
user_facing_fn()
#> ----------------
#> some_env$some_function(val)
#> ----------------
#> language `$.custom_class`(some_env, "some_function")
#> - attr(*, "srcref")= 'srcref' int [1:8] 14 3 14 29 3 29 14 14
#> ..- attr(*, "srcfile")=Classes 'srcfilecopy', 'srcfile' <environment: 0x000001d40b90c0c0>
#> NULL
#> ----------------
#> [1] "`$.custom_class`(some_env, \"some_function\")"
#> [1] 1
However, I can’t find a way to access the value of val after storing the expression in fc. As you can see, it is deparsed as `$.custom_class`(some_env, "some_function") but I cannot access val. I tried many rlang functions but couldn’t find something that works.
To clarify, what I want is to be able to access the value of val (in the example above, it would be 1) when I’m inside $.custom_class. Is this possible? I’m fine with using either base R or rlang.
Edit following MrFlick's comment:
My objective is that user_facing_fn() returns the output and an attribute containing the call to the internal function, like this:
...
# Make a user-facing function that calls the function stored in the custom
# environment under the hood
user_facing_fn <- function(val = 1) {
my_expr <- expr(some_env$some_function(!!val))
out <- eval_bare(my_expr)
attr(out, "original_query") <- my_expr
out
}
user_facing_fn(3)
#> [1] 3
#> attr(,"original_query")
#> some_env$some_function(3)
The problem is that I have many user-facing functions, and in some of them I want to capture several calls to functions stored in some_env. Therefore, I thought that instead of duplicating this expr() + !!, I could automatically capture the call in $ and I wouldn't need to modify the user-facing functions (or just slightly).
I think I found a way thanks to the various comments.
I’m just putting back my setting here:
library(rlang)
# Define a custom environment where I store a function.
# This is done in another package.
some_env <- new.env(parent = emptyenv())
class(some_env) <- "custom_class"
some_env$some_function <- function(x) {
x
}
# Make a user-facing function that calls the function stored in the custom
# environment under the hood
user_facing_fn <- function(val = 1) {
some_env$some_function(val)
}
user_facing_fn(1)
#> [1] 1
I can modify the functions in some_env so that I can obtain the call and store it somewhere (e.g in an attribute) before evaluating it. First I need eapply() to go through all the functions stored in some_env (in this example, there’s only some_function()):
modify_env <- function(env) {
# Here I overwrite all functions defined in `some_env`. In this example,
# there's only one.
eapply(env, function(fun) {
function(...) {
# Evaluate the args that are passed to the `some_function()`, which is
# only "val" in this example.
# First we capture unevaluated args, then we evaluate each of them in the
# caller env.
fc <- as.list(frame_call())
# The first element is the call, which is `some_env$some_function()` here.
# It is not an argument so I remove it.
fc1 <- fc[[1]]
fc[[1]] <- NULL
fc <- lapply(fc, eval_bare, env = caller_env())
# Evaluate the call. This produces the output (which is equal to the
# input in this example).
out <- call2(fun, !!!fc) |> eval_bare()
# Build the call that will be stored in the attributes of the output.
args <- list2(...)
full_call <- call2(fc1, !!!fc)
full_call <- deparse(full_call)
# Store the call in the attribute of the output.
attr(out, "original_expr") <- full_call
out
}
})
}
Now I define my own environment by cloning some_env and then modify it:
my_new_env <- modify_env(
env_clone(some_env)
)
Finally, I define a custom $ to access the call to some_env$some_function() before evaluating it. Here, instead of returning some_env$some_function, which would only return the input without storing the call, I return the modified function from the custom environment:
`$.custom_class` <- function(x, name) {
my_new_env[[name]]
}
We now have the original call stored in the output’s attributes:
user_facing_fn()
#> [1] 1
#> attr(,"original_expr")
#> [1] "some_env$some_function(1)"
user_facing_fn(3)
#> [1] 3
#> attr(,"original_expr")
#> [1] "some_env$some_function(3)"
If you love us? You can donate to us via Paypal or buy me a coffee so we can maintain and grow! Thank you!
Donate Us With