miniextendr_api/
s4_helpers.rs

1//! S4 slot access and class checking helpers.
2//!
3//! For new packages, [`S7`](https://rconsortium.github.io/S7/) is the
4//! recommended class system (use `#[miniextendr(s7)]`). These S4 helpers
5//! exist for interoperating with existing S4 packages — for example,
6//! reading slots from Bioconductor objects passed as function arguments.
7//!
8//! Since R's C API for S4 slot access (`R_has_slot`, `R_do_slot`,
9//! `R_do_slot_assign`) is not exposed in miniextendr's FFI bindings,
10//! these helpers use R expression evaluation via [`RCall`]
11//! as a fallback.
12//!
13//! All functions require being called from the R main thread and operate
14/// on raw SEXP values.
15///
16/// # Example
17///
18/// ```ignore
19/// use miniextendr_api::SEXP;
20/// use miniextendr_api::s4_helpers;
21///
22/// unsafe {
23///     if s4_helpers::s4_is(obj) {
24///         if let Some(class) = s4_helpers::s4_class_name(obj) {
25///             println!("S4 class: {class}");
26///         }
27///         let slot_val = s4_helpers::s4_get_slot(obj, "data")?;
28///     }
29/// }
30/// ```
31use crate::expression::{RCall, REnv, REvalError};
32use crate::{SEXP, SexpExt};
33
34/// Get the `methods` package namespace for evaluating S4 functions.
35///
36/// # Safety
37///
38/// Must be called from the R main thread.
39unsafe fn methods_namespace() -> Result<REnv, REvalError> {
40    unsafe { REnv::package_namespace("methods") }
41}
42
43/// Check if a SEXP is an S4 object.
44///
45/// # Safety
46///
47/// - `obj` must be a valid SEXP.
48/// - Must be called from the R main thread.
49#[inline]
50pub unsafe fn s4_is(obj: SEXP) -> bool {
51    obj.is_s4()
52}
53
54/// Check if an S4 object has a named slot.
55///
56/// Attempts to access the slot via [`s4_get_slot`]. Returns `true` if the
57/// slot exists and is accessible, `false` if accessing it errors (i.e.,
58/// the slot does not exist).
59///
60/// # Safety
61///
62/// - `obj` must be a valid SEXP (typically an S4 object).
63/// - Must be called from the R main thread.
64pub unsafe fn s4_has_slot(obj: SEXP, slot_name: &str) -> bool {
65    unsafe { s4_get_slot(obj, slot_name).is_ok() }
66}
67
68/// Get the value of a named slot from an S4 object.
69///
70/// Uses R's `slot(obj, name)` to access the slot value.
71///
72/// # Safety
73///
74/// - `obj` must be a valid S4 SEXP with the named slot.
75/// - Must be called from the R main thread.
76///
77/// # Returns
78///
79/// - `Ok(SEXP)` with the slot value (unprotected).
80/// - `Err(REvalError)` with R's error if the slot doesn't exist or another R
81///   error occurs.
82pub unsafe fn s4_get_slot(obj: SEXP, slot_name: &str) -> Result<SEXP, REvalError> {
83    unsafe {
84        let env = methods_namespace()?;
85        RCall::new("slot")
86            .arg(obj)
87            .named_arg("name", scalar_string(slot_name))
88            .eval(env.as_sexp())
89    }
90}
91
92/// Set the value of a named slot on an S4 object.
93///
94/// Uses R's `slot(obj, name) <- value` to assign the slot value.
95///
96/// # Safety
97///
98/// - `obj` must be a valid S4 SEXP with the named slot.
99/// - `value` must be a valid SEXP of the appropriate type for the slot.
100/// - Must be called from the R main thread.
101///
102/// # Returns
103///
104/// - `Ok(())` on success.
105/// - `Err(REvalError)` with R's error if the slot doesn't exist or the value
106///   type is incompatible.
107pub unsafe fn s4_set_slot(obj: SEXP, slot_name: &str, value: SEXP) -> Result<(), REvalError> {
108    unsafe {
109        // slot(obj, name) <- value  is equivalent to `slot<-`(obj, name, value)
110        let env = methods_namespace()?;
111        RCall::new("slot<-")
112            .arg(obj)
113            .named_arg("name", scalar_string(slot_name))
114            .named_arg("value", value)
115            .eval(env.as_sexp())?;
116        Ok(())
117    }
118}
119
120/// Extract the S4 class name from an object.
121///
122/// Reads the `class` attribute and returns the first element as a `String`.
123/// Returns `None` if the object has no class attribute or the attribute is empty.
124///
125/// # Safety
126///
127/// - `obj` must be a valid SEXP.
128/// - Must be called from the R main thread.
129pub unsafe fn s4_class_name(obj: SEXP) -> Option<String> {
130    unsafe {
131        let class_attr = obj.get_class();
132        if class_attr.is_null_or_nil() || class_attr.xlength() == 0 {
133            return None;
134        }
135
136        let first = class_attr.string_elt(0);
137        crate::from_r::charsxp_to_string_lossy(first)
138    }
139}
140
141// region: Internal helpers
142
143/// Create a scalar R character string from a Rust `&str`.
144///
145/// The returned SEXP is unprotected — caller must protect if further
146/// allocations will occur before use.
147#[inline]
148fn scalar_string(s: &str) -> SEXP {
149    SEXP::scalar_string_from_str(s)
150}
151
152#[cfg(test)]
153mod tests {
154    use super::*;
155
156    #[test]
157    fn s4_is_compiles() {
158        // Verify the function signature compiles.
159        // Actual testing requires the R runtime.
160        fn assert_fn<F: Fn(SEXP) -> bool>(_f: F) {}
161        assert_fn(|s| unsafe { s4_is(s) });
162    }
163
164    #[test]
165    fn s4_class_name_compiles() {
166        fn assert_fn<F: Fn(SEXP) -> Option<String>>(_f: F) {}
167        assert_fn(|s| unsafe { s4_class_name(s) });
168    }
169}
170// endregion
miniextendr_api/s4_helpers.rs

miniextendr_api/
s4_helpers.rs
