Show property defaults when printing a class

NEWS.md

@@ -2,7 +2,6 @@
 
 * Errors thrown by S7 now report the function where they occurred, making it easier to track down the source of a problem (#646).
 * `method<-` now accepts `NULL` to unregister an existing method, e.g. `method(foo, class_character) <- NULL` (#613).
-* `new_object()` no longer materialises ALTREP parent values (e.g. `seq_len()`), so constructing an S7 object that wraps a large compact integer sequence is now O(1) in memory instead of O(n) (@kschaubroeck, #607).
 * Method dispatch on `class_missing` now correctly handles missing arguments forwarded through a wrapper functions (#595).
 * `S7_error_method_not_found` now has a correct class vector without a duplicate `"error"` entry (@jjjermiah, #604).
 * `convert()` now falls back to the corresponding `as.*()` function (e.g. `as.character()`) when converting to a base type like `class_character` and no method or inheritance-based default applies, so `convert(1, class_character)` works out of the box (#472).
@@ -20,6 +19,7 @@
 * `new_property()` now accepts a `setter` that takes `self`, `name`, and `value` making it easy to reuse the same definition for multiple properties (#552).
 * `new_S3_class()` objects now work with `inherits()` (and other functions that use `nameOfClass()`) in R 4.3 and later (@lawremi, #521).
 * New `prop_info()` returns a data frame summarising the properties of an S7 object or class, with one row per property and columns for name, default, class, getter, setter, and validator (#551).
+* `print(<S7_class>)` now shows property defaults inline (`= "value"`) and annotates read-only properties (`[read-only]`) (#439).
 * `prop()` and `prop<-()` errors from custom getters and setters now report a synthetic `<Class>@<prop>` call, making it easier to see which property triggered the error (#536, #627, #638).
 * `prop()` no longer leaves an object in a broken state when a custom getter signals an error (#520, #640, #638).
 * `prop<-()` no longer fails when assigning a call or symbol to a property (#511, #633, #638).

R/class.R

@@ -189,9 +189,19 @@ check_S7_constructor <- function(constructor, call = sys.call(-1L)) {
 print.S7_class <- function(x, ...) {
   props <- x@properties
   if (length(props) > 0) {
-    prop_names <- format(names(props))
-    prop_types <- format(vcapply(props, function(x) class_desc(x$class)))
-    prop_fmt <- paste0(" $ ", prop_names, ": ", prop_types, "\n", collapse = "")
+    prop_names <- names(props)
+    prop_defaults <- vcapply(props, prop_default_desc, package = x@package)
+    prop_types <- vcapply(props, function(p) class_desc(p$class))
+    suffix <- ifelse(prop_defaults == "", "", paste0(" ", prop_defaults))
+    prop_fmt <- paste0(
+      " $ ",
+      prop_names,
+      ": ",
+      prop_types,
+      suffix,
+      "\n",
+      collapse = ""
+    )
   } else {
     prop_fmt <- ""
   }

R/property.R

@@ -178,6 +178,35 @@ prop_default <- function(prop, envir, package) {
   prop$default %||% class_construct_expr(prop$class, envir, package)
 }
 
+prop_default_desc <- function(prop, package = NULL) {
+  if (prop_is_read_only(prop)) {
+    return("[read-only]")
+  }
+
+  if (!is.null(prop$default)) {
+    paste0("= ", deparse1(prop$default))
+  } else {
+    desc <- class_default_desc(prop$class, package)
+    if (is.null(desc)) "" else paste0("= ", desc)
+  }
+}
+
+# A clean, displayable string for a property's implicit default, or `NULL` if
+# the class has no meaningful default (e.g. `class_any`, `class_missing`).
+class_default_desc <- function(class, package = NULL) {
+  type <- class_type(class)
+
+  expr <- switch(
+    type,
+    NULL = "NULL",
+    S7_base = deparse1(class_construct_expr(class, package = package)),
+    S7 = deparse1(call(class@name)),
+    S7_union = class_default_desc(class$classes[[1]], package),
+    S4 = deparse1(call(class@className)),
+    NULL
+  )
+}
+
 #' Get/set a property
 #'
 #' - `prop(x, "name")` / `prop@name` get the value of the a property,

tests/testthat/_snaps/class.md

@@ -8,8 +8,8 @@
       @ constructor: function(x, y) {...}
       @ validator  : <NULL>
       @ properties :
-       $ x: <integer>
-       $ y: <integer>
+       $ x: <integer> = integer(0)
+       $ y: <integer> = integer(0)
     Code
       str(foo2)
     Output
@@ -52,6 +52,23 @@
       @ validator  : <NULL>
       @ properties :
 
+# S7 classes / shows property defaults and read-only annotations
+
+    Code
+      Person
+    Output
+      <S7::Person> class
+      @ parent     : <S7_object>
+      @ constructor: function(implicit_default, implicit_complex, implicit_S7, default_value, default_expr) {...}
+      @ validator  : <NULL>
+      @ properties :
+       $ implicit_default: <character> = character(0)
+       $ implicit_complex: S3<Date>
+       $ implicit_S7: <S7::Address> = Address()
+       $ default_value: <character> = ""
+       $ default_expr: S3<Date> = Sys.Date()
+       $ read_only: <ANY> [read-only]
+
 # S7 classes / checks inputs
 
     Code

tests/testthat/_snaps/property.md

@@ -110,13 +110,13 @@
       @ constructor: function(anything, null, base, S3, S4, S7, S7_union) {...}
       @ validator  : <NULL>
       @ properties :
-       $ anything: <ANY>                 
-       $ null    : <NULL>                
-       $ base    : <integer>             
-       $ S3      : S3<factor>            
-       $ S4      : S4<class_S4>          
-       $ S7      : <class_S7>            
-       $ S7_union: <integer> or <logical>
+       $ anything: <ANY>
+       $ null: <NULL> = NULL
+       $ base: <integer> = integer(0)
+       $ S3: S3<factor>
+       $ S4: S4<class_S4> = class_S4()
+       $ S7: <class_S7> = class_S7()
+       $ S7_union: <integer> or <logical> = integer(0)
 
 ---
 

tests/testthat/test-class.R

@@ -32,6 +32,23 @@ describe("S7 classes", {
     expect_snapshot(foo)
   })
 
+  it("shows property defaults and read-only annotations", {
+    Address <- new_class("Address", package = "S7")
+    Person <- new_class(
+      "Person",
+      properties = list(
+        implicit_default = new_property(class_character),
+        implicit_complex = new_property(class_Date),
+        implicit_S7 = new_property(Address),
+        default_value = new_property(class_character, default = ""),
+        default_expr = new_property(class_Date, default = quote(Sys.Date())),
+        read_only = new_property(getter = \(self) Sys.Date() - self@birthdate)
+      ),
+      package = "S7"
+    )
+    expect_snapshot(Person)
+  })
+
   it("checks inputs", {
     expect_snapshot(error = TRUE, {
       new_class(1)