Skip to content

Instantly share code, notes, and snippets.

@klmr
Last active January 24, 2024 08:27
Show Gist options
  • Star 0 You must be signed in to star a gist
  • Fork 0 You must be signed in to fork a gist
  • Save klmr/d31ac217effeaad2213f2a588c83ead4 to your computer and use it in GitHub Desktop.
Save klmr/d31ac217effeaad2213f2a588c83ead4 to your computer and use it in GitHub Desktop.
R6 classes without the repetition
r6_class(
MyClass,
{
initialize = function (x) {
private$x = x
}
get = function () private$x
},
private = {
x = NULL
}
)
MyClass(x = 42)$get()
# [1] 42
r6_class = function (name, public = {}, private = {}, ...) {
block_to_named = function (block) {
is_assign = function (expr) {
is.call(expr) && as.character(expr[[1L]]) %in% c("=", "<-")
}
stopifnot(identical(block[[1L]], quote(`{`)))
block = block[-1L]
stopifnot(all(vapply(block, is_assign, logical(1L))))
names = lapply(block, `[[`, 2L)
values = lapply(lapply(block, `[[`, 3L), eval, envir = caller)
setNames(values, names)
}
caller = parent.frame()
stopifnot(is.name(substitute(name)))
name = deparse1(substitute(name))
dots = match.call(expand.dots = FALSE)$...
dots$public = block_to_named(substitute(public))
dots$private = block_to_named(substitute(private))
impl = do.call(R6::R6Class, c(name, dots))
assign(name, impl$new, envir = caller)
}
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment