Protocol for extending the variables pane

crates/ark/Cargo.toml

@@ -55,6 +55,7 @@ yaml-rust = "0.4.5"
 winsafe = { version = "0.0.19", features = ["kernel"] }
 struct-field-names-as-array = "0.3.0"
 strum = "0.26.2"
+strum_macros = "0.26.2"
 futures = "0.3.30"
 tracing = "0.1.40"
 tracing-subscriber = { version = "0.3.18", features = ["env-filter"] }

crates/ark/src/lib.rs

@@ -21,6 +21,7 @@ pub mod json;
 pub mod logger;
 pub mod logger_hprof;
 pub mod lsp;
+pub mod methods;
 pub mod modules;
 pub mod modules_utils;
 pub mod plots;

crates/ark/src/methods.rs

@@ -0,0 +1,89 @@
+//
+// methods.rs
+//
+// Copyright (C) 2024 by Posit Software, PBC
+//
+//
+
+use anyhow::anyhow;
+use harp::call::RArgument;
+use harp::exec::RFunction;
+use harp::exec::RFunctionExt;
+use harp::r_null;
+use harp::utils::r_is_object;
+use harp::RObject;
+use libr::SEXP;
+use strum_macros::Display;
+use strum_macros::EnumIter;
+use strum_macros::EnumString;
+use strum_macros::IntoStaticStr;
+
+use crate::modules::ARK_ENVS;
+
+#[derive(Debug, PartialEq, EnumString, EnumIter, IntoStaticStr, Display, Eq, Hash, Clone)]
+pub enum ArkGenerics {
+    #[strum(serialize = "ark_positron_variable_display_value")]
+    VariableDisplayValue,
+
+    #[strum(serialize = "ark_positron_variable_display_type")]
+    VariableDisplayType,
+
+    #[strum(serialize = "ark_positron_variable_has_children")]
+    VariableHasChildren,
+
+    #[strum(serialize = "ark_positron_variable_kind")]
+    VariableKind,
+}
+
+impl ArkGenerics {
+    // Dispatches the method on `x`
+    // Returns
+    //   - `None` if no method was found,
+    //   - `Err` if method was found and errored
+    //   - `Err` if the method result could not be coerced to `T`
+    //   - T, if method was found and was successfully executed
+    pub fn try_dispatch<T>(&self, x: SEXP, args: Vec<RArgument>) -> anyhow::Result<Option<T>>
+    where
+        // Making this a generic allows us to handle the conversion to the expected output
+        // type within the dispatch, which is much more ergonomic.
+        T: TryFrom<RObject>,
+        <T as TryFrom<RObject>>::Error: std::fmt::Debug,
+    {
+        if !r_is_object(x) {
+            return Ok(None);
+        }
+
+        let generic: &str = self.into();
+        let mut call = RFunction::new("", "call_ark_method");
+
+        call.add(generic);
+        call.add(x);
+
+        for RArgument { name, value } in args.into_iter() {
+            call.param(name.as_str(), value);
+        }
+
+        let result = call.call_in(ARK_ENVS.positron_ns)?;
+
+        // No method for that object
+        if result.sexp == r_null() {
+            return Ok(None);
+        }
+
+        // Convert the result to the expected return type
+        match result.try_into() {
+            Ok(value) => Ok(Some(value)),
+            Err(err) => Err(anyhow!("Conversion failed: {err:?}")),
+        }
+    }
+
+    pub fn register_method(&self, class: &str, method: RObject) -> anyhow::Result<()> {
+        let generic_name: &str = self.into();
+        RFunction::new("", ".ark.register_method")
+            .add(RObject::try_from(generic_name)?)
+            .add(RObject::try_from(class)?)
+            .add(method)
+            .call_in(ARK_ENVS.positron_ns)?;
+        Ok(())
+    }
+}

crates/ark/src/modules/positron/methods.R

@@ -0,0 +1,61 @@
+#
+# methods.R
+#
+# Copyright (C) 2024 Posit Software, PBC. All rights reserved.
+#
+#
+
+ark_methods_table <- new.env(parent = emptyenv())
+ark_methods_table$ark_positron_variable_display_value <- new.env(parent = emptyenv())
+ark_methods_table$ark_positron_variable_display_type <- new.env(parent = emptyenv())
+ark_methods_table$ark_positron_variable_has_children <- new.env(parent = emptyenv())
+ark_methods_table$ark_positron_variable_kind <- new.env(parent = emptyenv())
+lockEnvironment(ark_methods_table, TRUE)
+
+ark_methods_allowed_packages <- c("torch", "reticulate")
+
+#' Register the methods with the Positron runtime
+#'
+#' @param generic Generic function name as a character to register
+#' @param class Class name as a character
+#' @param method A method to be registered. Should be a call object.
+#' @export
+.ark.register_method <- function(generic, class, method) {
+
+    # Check if the caller is an allowed package
+    if (!in_ark_tests()) {
+        calling_env <- .ps.env_name(topenv(parent.frame()))
+        if (!(calling_env %in% paste0("namespace:", ark_methods_allowed_packages))) {
+            stop("Only allowed packages can register methods. Called from ", calling_env)
+        }
+    }
+
+    stopifnot(
+        is_string(generic),
+        generic %in% names(ark_methods_table),
+        typeof(class) == "character"
+    )
+    for (cls in class) {
+        assign(cls, method, envir = ark_methods_table[[generic]])
+    }
+    invisible()
+}
+
+call_ark_method <- function(generic, object, ...) {
+    methods_table <- ark_methods_table[[generic]]
+
+    if (is.null(methods_table)) {
+        return(NULL)
+    }
+
+    for (cls in class(object)) {
+        if (!is.null(method <- get0(cls, envir = methods_table))) {
+            return(eval(
+                as.call(list(method, object, ...)),
+                envir = globalenv()
+            ))
+        }
+    }
+
+    NULL
+}