Experimentation with R6 and S7 hybrid. Allows for the creation of mutable objects with type-safe properties as well as self-referential methods.

r67.R

# What do i want from an object oriented R class system?
# opt-in public immutability - neither. Accomplished with private property with active binding in R6
# interior mutability - R6
# type safety - S7
# self-referential methods - R6

# private methods don't have any type safety they can be whatever you want. 
# immutables can only be set at creation and class doesn't matter

# Each .public & .private element must be named 
#   and must be an S7 Object or a function

# .public is put in the private part of R6 has a getter (active binding) 
# and has a setter `set_{arg}`


# helper function to create setters 

library(R6)
library(S7)

make_setter <- function(.name) {
  setter_fmt <- "function(.x) {
    check_is_S7(.x, r67_env[['pub_props']][['%s']])
    private$.%s <- .x
    self
  }"
  rlang::eval_bare(rlang::parse_expr(sprintf(setter_fmt, .name, .name)))
}

new_r67 <- function(
  class, 
  .public = list(),
  .immutable = list(),
  .private = list()
) {

  # we check that all of the elements are named 
  if (!rlang::is_named2(.public) || !rlang::is_named2(.private) || !rlang::is_named2(.immutable)) {
    cli::cli_abort("all properties must be named")
  }

  # we ensure that they are all functions or S7 classes
  for (cls in c(.public, .private)) {
    if (!inherits(cls, c("S7_class", "function"))) {
      cli::cli_abort("Each property must be an {.cls S7} class or a function")
    }
  }

  # we identify which ones are s7 classes
  pub_s7_idx <- vapply(.public, inherits, logical(1), "S7_class")

  # subet to only the s7 classes and methods respectively
  pub_props <- .public[pub_s7_idx]
  pub_methods <- .public[!pub_s7_idx]

  # we store the public s7 classes in an evironment
  r67_env <- rlang::new_environment()
  r67_env[["pub_props"]] <- pub_props

  # store the immutables in the environment as well they'll be accessed via active binding
  r67_env[["immutables"]] <- .immutable

  # make getters for immutable objects
  immut_getters <- lapply(names(.immutable), function(.nm) {
    rlang::eval_bare(
      rlang::parse_expr(
        sprintf("function() r67_env[['immutables']][['%s']]", .nm)
      )
    )
  })

  names(immut_getters) <- names(.immutable)

  # extract the names of these props
  pub_prop_names <- names(pub_props)

  # create a list of setters 
  .pub_setters <- Map(
    make_setter,
    pub_prop_names
  )
  # modify the names to include set_{}
  names(.pub_setters) <- paste0("set_", pub_prop_names)

  # create a named list of functions to act as the getters
  # this will be put into active bindings
  .pub_getters <- Map(function(.name) {
    rlang::eval_bare(
      rlang::parse_expr(
        sprintf("function() private$.%s", .name)
      )
    )
  }, pub_prop_names)

  R6Class(
    class,
    public = c(.pub_setters, pub_methods),
    active = c(.pub_getters, immut_getters),
    private = rlang::new_list(
      length(.pub_getters),
      paste0(".", pub_prop_names)
    )
  )
}


# create some sample s7 object
pet <- S7::new_class("pet")
book <- S7::new_class("book")
person <- S7::new_class("person")
secret <- S7::new_class("secret")


# create lists 
.public <- list(pet = pet, book = book, me = \(){})
.private <- list(internal = function(.x) .x)


my_class <- new_r67(
  "my_r67",
  .public,
  # immutable x vector
  list(x = rnorm(100)),
  .private
)

# create a new instance
x <- my_class$new()

# view immutable value
x$x

# try setting immutable
x$x <- 1L

# try setting mutable prop w/ wrong class
x$set_book(list('x'))

# try setting with s7 object
x$set_book(book())

# now get it 
x$book

This operates directly on the AST and is therefore slightly more resilient to non-syntactic names:

make_setter <- function(.name) {
  setter <- substitute(function(.x) {
    check_is_S7(.x, r67_env[['pub_props']][[c.name]])
    private$s.name <- .x
    self
  }, list(c.name = .name, s.name = as.name(.name)))
  rlang::eval_bare(setter)
}

The source reference of the returned function will look incorrect, unfortunately.

@aitap I don't think that will work because the result is a function that looks for the object c.name which will not be found

Very nice!
I think there is a good chance we will add support for using a class_environment for the parent type in S7, once the backlog is a little smaller. It's just too early to engage with the question. (e.g., RConsortium/S7#253)

You might enjoy taking a look at https://github.com/t-kalinowski/R9000, which has similar semantics to Python's class system.

Thanks @t-kalinowski! I dont quite yet see how having a class_environment would help us in the case of S7? Is the idea that we could use the environment for mutability?

It would bring reference semantics (i.e., modify-in-place) for objects, similar to R6.

@JosiahParry I agree that's quite confusing, especially since it seems to work if I return the unevaluated expression but then it shows c.name and s.name once again after being evaluated.

What gives?

Source references. The fourth argument in the unevaluated call to function contains the text used to construct the function, and rewriting the AST using substitute does not change or remove that argument. The function doesn't look like it, but it should work:

# make_setter('foo') |> removeSource()
function (.x)
{
    check_is_S7(.x, r67_env[["pub_props"]][["foo"]])
    private$foo <- .x
    self
}
# <environment: 0x55c7f053f180>

Edit: you can avoid the problem if you avoid eval altogether and construct the function from parts:

make_setter <- function(.name)
  as.function(c(alist(.x=), list(substitute({
    check_is_S7(.x, r67_env[['pub_props']][[c.name]])
    private$s.name <- .x
    self
  }, list(c.name = .name, s.name = as.name(.name))))))