Add back correct S4 support to the variables pane (#658)

* Add back correct S4 support

* match with `starts_with()`

Author: dfalbel

crates/ark/src/variables/variable.rs

@@ -30,6 +30,7 @@ use harp::utils::pairlist_size;
 use harp::utils::r_altrep_class;
 use harp::utils::r_assert_type;
 use harp::utils::r_classes;
+use harp::utils::r_format_s4;
 use harp::utils::r_inherits;
 use harp::utils::r_is_altrep;
 use harp::utils::r_is_data_frame;
@@ -100,6 +101,7 @@ impl WorkspaceVariableDisplayValue {
             LANGSXP => Self::from_language(value),
             _ if r_is_matrix(value) => Self::from_matrix(value)?,
             RAWSXP | LGLSXP | INTSXP | REALSXP | STRSXP | CPLXSXP => Self::from_default(value)?,
+            _ if r_is_s4(value) => Self::from_s4(value)?,
             _ => Self::from_error(Error::Anyhow(anyhow!(
                 "Unexpected type {}",
                 r_type2char(r_typeof(value))
@@ -336,6 +338,20 @@ impl WorkspaceVariableDisplayValue {
         Ok(Self::new(display_value, false))
     }
 
+    fn from_s4(value: SEXP) -> anyhow::Result<Self> {
+        let result: Vec<String> = RObject::from(r_format_s4(value)?).try_into()?;
+        let mut display_value = String::from("");
+        for val in result.iter() {
+            for char in val.chars() {
+                if display_value.len() >= MAX_DISPLAY_VALUE_LENGTH {
+                    return Ok(Self::new(display_value, true));
+                }
+                display_value.push(char);
+            }
+        }
+        Ok(Self::new(display_value, false))
+    }
+
     fn from_default(value: SEXP) -> anyhow::Result<Self> {
         let formatted = FormattedVector::new(RObject::from(value))?;
 
@@ -1886,6 +1902,16 @@ mod tests {
             )
             .unwrap();
 
+            let path = vec![];
+            let vars = PositronVariable::inspect(env.clone(), &path).unwrap();
+
+            assert_eq!(vars.len(), 1);
+            // Matching equality is not nice because the default `format` method for S4 objects
+            // uses different quoting characters on Windows vs Unix.
+            // Unix: <S4 class ‘ddiMatrix’ [package “Matrix”] with 4 slots>
+            // Windows: <S4 class 'ddiMatrix' [package "Matrix"] with 4 slots>
+            assert!(vars[0].display_value.starts_with("<S4 class"));
+
             // Inspect the S4 object
             let path = vec![String::from("x")];
             let fields = PositronVariable::inspect(env.clone(), &path).unwrap();
@@ -2032,4 +2058,20 @@ mod tests {
             assert_eq!(vars[0].display_value, "[]");
         });
     }
+
+    #[test]
+    fn test_s4_with_different_length() {
+        r_task(|| {
+            let env = Environment::new_empty().unwrap();
+            // Matrix::Matrix objects have length != 1, but their format() method returns a length 1 character
+            // describing their class.
+            let value = harp::parse_eval_base("Matrix::Matrix(0, nrow= 10, ncol = 10)").unwrap();
+            env.bind("x".into(), &value);
+
+            let path = vec![];
+            let vars = PositronVariable::inspect(env.into(), &path).unwrap();
+            assert_eq!(vars.len(), 1);
+            assert!(vars[0].display_value.starts_with("<S4 class"),);
+        })
+    }
 }

crates/harp/src/modules/format.R

@@ -86,3 +86,34 @@ init_test_format <- function() {
 
     environment()
 }
+
+harp_format_s4 <- function(x, ...) {
+    # For S4 values we assume that the formatted value is a character vector of length 1,
+    # even if the value has length > 1. This is because the formatted value is typically
+    # the class of the object, which is a single string.
+    # If for some reason the formatted value is not a character vector of length 1, we
+    # check if the result is a character vector the same length as `value`.
+    out <- base::format(x, ...)
+
+    if (length(out) != 1 && length(out) != length(x)) {
+        log_trace(sprintf(
+            "`format()` method for <%s> should return a character vector of length 1 or the same length as the object.",
+            class_collapsed(x)
+        ))
+        return(format_fallback_s4(x))
+    }
+
+    if (!is.character(out)) {
+        log_trace(sprintf(
+            "`format()` method for <%s> should return a character vector.",
+            class_collapsed(x)
+        ))
+        return(format_fallback_s4(x))
+    }
+
+    out
+}
+
+format_fallback_s4 <- function(x) {
+    paste0("<S4 class '", class_collapsed(x), "'>")
+}

crates/harp/src/utils.rs

@@ -735,6 +735,17 @@ pub fn r_format_vec(x: SEXP) -> Result<SEXP> {
     }
 }
 
+pub fn r_format_s4(x: SEXP) -> Result<SEXP> {
+    if !r_is_s4(x) {
+        return Err(Error::UnexpectedType(r_typeof(x), vec![S4SXP]));
+    }
+
+    let out = RFunction::new("", "harp_format_s4")
+        .add(x)
+        .call_in(unsafe { HARP_ENV.unwrap() })?;
+    Ok(out.sexp)
+}
+
 pub fn r_subset_vec(x: SEXP, indices: Vec<i64>) -> Result<SEXP> {
     let env = unsafe { HARP_ENV.unwrap() };
     let indices: Vec<i64> = indices.into_iter().map(|i| i + 1).collect();