avoid depend on the object subset method ($)

[Yunuuuu]

It would be nice if R6-like documents can be used by other similar object.

I want to dispath methods written in rust and then write R document with roxygen2.

Since I will re-dispath $. and [[. methods of the namespace, which will cause roxygen2 not working. This commit just avoid $. and [[. methods when dealing with R6 object document by using .subset2, which should work for current all implementation and should be faster.

Suppose I have an Enum object named TimeUnit from rust, Enum object in R should be something similar with an environment bound with all active binding fields. new_namespace will just mimic R6 generator, so we can add document with roxygen2.

all_named <- function(x) {
    if (length(names(x)) != length(x) || any(names(x) == "")) {
        return(FALSE)
    }
    TRUE
}

all_functions <- function(x) all(vapply(x, is.function, logical(1L)))

new_namespace <- function(classname, public = list(),
                          active = list(), class = NULL) {
    # classname: used to define roxygen2 alias
    # class: add into final object class attribute
    if (missing(classname)) classname <- class
    if (!all_named(public) || !all_named(active)) {
        stop("All elements of public, and active must be named.")
    }
    if (!all_functions(active)) {
        stop("All items in active must be functions.")
    }
    namespace <- new.env(parent = emptyenv())

    # use the same name of `R6ClassGenerator` object.
    namespace$portable <- FALSE
    namespace$classname <- classname
    namespace$cloneable <- FALSE
    namespace$class <- FALSE
    namespace$lock_class <- TRUE
    # https://github.com/r-lib/roxygen2/blob/main/R/object-r6.R#L139
    # namespace$inherit <- NULL # must be NULL for roxygen2 work

    # assign methods into namespace
    # namespace$private_fields <- NULL
    # namespace$private_methods <- NULL
    # namespace$public_fields <- NULL
    if (length(public)) {
        namespace$public_methods <- public
    }
    if (length(active)) {
        namespace$active <- active
    }

    # we assign a `R6ClassGenerator` class, in this ways,
    # we can utilize roxygen2 R6 style document
    structure(namespace, class = c(class, "R6ClassGenerator"))
}

###########################################################
# For example
# `call_timeunit_method` will call R `.Call` function.
# following will use R6-style documents to doc `tunits` object.

#' TimeUnit object
#' @export
tunits <- new_namespace(
    class = "tunits",
    active = list(
        #' @field Nanoseconds Unit of time "ns".
        Nanoseconds = function() {
            call_timeunit_method("Nanoseconds")
        },

        #' @field Microseconds Unit of time "us".
        Microseconds = function() {
            call_timeunit_method("Microseconds")
        },

        #' @field Milliseconds Unit of time "ms".
        Milliseconds = function() {
            call_timeunit_method("Milliseconds")
        }
    )
)

dispatch_method <- function(.__namespace__, .__class__) {
    # we use special name to prevent override other function (also known as private methods) defined this package
    force(.__namespace__)
    force(.__class__) # just for message
    function(self, .__name__) {
        # environment used to find `self`, `self` should be the data value
        # the parent environment of this environment is the package namespace
        # it's safe to just change the function environment in this package
        force(self)
        .__enclos_env__ <- environment()
        .__public_env__ <- .subset2(.__namespace__, "public_methods")
        .__active_env__ <- .subset2(.__namespace__, "active")
        if (!is.null(.__fn__ <- .subset2(.__public_env__, .__name__))) {
            environment(.__fn__) <- .__enclos_env__
            .__fn__
        } else if (
            !is.null(.__fn__ <- .subset2(.__active_env__, .__name__))) {
            environment(.__fn__) <- .__enclos_env__
            makeActiveBinding(".__active_fn__", .__fn__, .__enclos_env__)
            .__active_fn__ # nolint
        } else {
            stop(sprintf("No method `%s` found for %s", .__name__, .__class__))
        }
    }
}

#' @export
`$.tunits` <- dispatch_method(tunits, "`TimeUnit` namespace")

#' @export
`[[.tunits` <- `$.tunits`