Reusable property setters

[jonthegeek]

As far as I can tell, it isn't possible to make a reusable setter in a property without wrapping new_property() in a factory, since we need to set self@property, and we don't know property's name in context.

Would it be possible to either allow setter() to have more arguments, or to make the name of property (and, ideally, the caller env) available somehow?

This is how I'm currently dealing with this sort of thing (specifically something like the _better level). This example is somewhat contrived, but I have more-realistic cases where I want to coerce when possible (eg, values that are likely to come in as character but that I'd like to coerce to integer when that can be done so cleanly).

library(S7)

my_class_strict <- S7::new_class(
  "my_class_strict",
  properties = list(
    name = class_character,
    age = class_integer
  )
)
my_class_strict(name = "Jon", age = 48)
#> Error: <my_class_strict> object properties are invalid:
#> - @age must be <integer>, not <double>

prop_integerish <- S7::new_property(
  class = class_integer,
  setter = function(self, value) {
    if (rlang::is_integerish(value)) {
      value <- as.integer(value)
    }
    # Only works for a property named "age", I can't figure out how to make a
    # reusable setter without the wrapper below.
    S7::prop(self, "age") <- value
    return(self)
  }
)
my_class <- S7::new_class(
  "my_class",
  properties = list(
    name = class_character,
    age = prop_integerish
  )
)
my_class(name = "Jon", age = 48)
#> <my_class>
#>  @ name: chr "Jon"
#>  @ age : int 48
my_class(name = "Jon", age = 48.2)
#> Error: <my_class>@age must be <integer>, not <double>

my_other_class <- S7::new_class(
  "my_other_class",
  properties = list(
    width = prop_integerish
  )
)
my_other_class(48)
#> Error: Can't find property <my_other_class>@age

prop_integerish_better <- function(x_arg, ...) {
  S7::new_property(
    class = class_integer,
    setter = function(self, value) {
      call <- rlang::caller_env(3) # Ewww
      if (rlang::is_integerish(value)) {
        S7::prop(self, x_arg) <- as.integer(value)
        return(self)
      }
      cli::cli_abort(
        c(
          "{.arg {x_arg}} must be coercible to {.cls integer}.",
          "*" = "{.arg {x_arg}} is {.obj_type_friendly {value}}."
        ), 
        call = call
      )
    }
  )
}
my_class_better <- S7::new_class(
  "my_class_better",
  properties = list(
    name = class_character,
    age = prop_integerish_better("age")
  )
)
my_class_better(name = "Jon", age = 48)
#> <my_class_better>
#>  @ name: chr "Jon"
#>  @ age : int 48
my_class_better(name = "Jon", age = 48.2)
#> Error in `my_class_better()`:
#> ! `age` must be coercible to <integer>.
#> • `age` is a number.

prop_integerish_almost <- function(x_arg, ...) {
  S7::new_property(
    class = class_integer,
    setter = function(self, value) {
      if (rlang::is_integerish(value)) {
        value <- as.integer(value)
      }
      S7::prop(self, x_arg) <- value
      return(self)
    }
  )
}
my_class_almost <- S7::new_class(
  "my_class_better",
  properties = list(
    name = class_character,
    age = prop_integerish_almost("age")
  )
)
y_class_almost(name = "Jon", age = 48)
#> <my_class_better>
#>  @ name: chr "Jon"
#>  @ age : int 48
my_class_almost(name = "Jon", age = 48.2)
#> Error: <my_class_better>@age must be <integer>, not <double>

^{Created on 2023-09-28 with reprex v2.0.2}

Alternatively, is there a way to implement this with class_integerish rather than prop_integerish? I got close, but I had to give class_integerish a named property that made printing ugly, and I still had to do caller_env(N) tricks to make the error messages work right.

[hadley]

I'd just make a wrapper function:

library(S7)

prop_integer_coerce <- function(name) {
  new_property(
    name = name,
    class = class_integer,
    setter = function(self, value) {
      if (rlang::is_integerish(value)) {
        value <- as.integer(value)
      }
      prop(self, name) <- value
      self
    }
  )
}

my_class_strict <- new_class(
  "my_class_strict",
  properties = list(
    name = class_character,
    age = prop_integer_coerce("age")
  )
)
my_class_strict(name = "Jon", age = 48)

The fact that you need to specific age twice in the property list is a bug; I've filed it at #371.