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};
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, String> {
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(String)` if the slot doesn't exist or another R error occurs.
81pub unsafe fn s4_get_slot(obj: SEXP, slot_name: &str) -> Result<SEXP, String> {
82    unsafe {
83        let env = methods_namespace()?;
84        RCall::new("slot")
85            .arg(obj)
86            .named_arg("name", scalar_string(slot_name))
87            .eval(env.as_sexp())
88    }
89}
90
91/// Set the value of a named slot on an S4 object.
92///
93/// Uses R's `slot(obj, name) <- value` to assign the slot value.
94///
95/// # Safety
96///
97/// - `obj` must be a valid S4 SEXP with the named slot.
98/// - `value` must be a valid SEXP of the appropriate type for the slot.
99/// - Must be called from the R main thread.
100///
101/// # Returns
102///
103/// - `Ok(())` on success.
104/// - `Err(String)` if the slot doesn't exist or the value type is incompatible.
105pub unsafe fn s4_set_slot(obj: SEXP, slot_name: &str, value: SEXP) -> Result<(), String> {
106    unsafe {
107        // slot(obj, name) <- value  is equivalent to `slot<-`(obj, name, value)
108        let env = methods_namespace()?;
109        RCall::new("slot<-")
110            .arg(obj)
111            .named_arg("name", scalar_string(slot_name))
112            .named_arg("value", value)
113            .eval(env.as_sexp())?;
114        Ok(())
115    }
116}
117
118/// Extract the S4 class name from an object.
119///
120/// Reads the `class` attribute and returns the first element as a `String`.
121/// Returns `None` if the object has no class attribute or the attribute is empty.
122///
123/// # Safety
124///
125/// - `obj` must be a valid SEXP.
126/// - Must be called from the R main thread.
127pub unsafe fn s4_class_name(obj: SEXP) -> Option<String> {
128    unsafe {
129        let class_attr = obj.get_class();
130        if class_attr.is_null_or_nil() || class_attr.xlength() == 0 {
131            return None;
132        }
133
134        let first = class_attr.string_elt(0);
135        crate::from_r::charsxp_to_string_lossy(first)
136    }
137}
138
139// region: Internal helpers
140
141/// Create a scalar R character string from a Rust `&str`.
142///
143/// The returned SEXP is unprotected — caller must protect if further
144/// allocations will occur before use.
145#[inline]
146fn scalar_string(s: &str) -> SEXP {
147    SEXP::scalar_string_from_str(s)
148}
149
150#[cfg(test)]
151mod tests {
152    use super::*;
153
154    #[test]
155    fn s4_is_compiles() {
156        // Verify the function signature compiles.
157        // Actual testing requires the R runtime.
158        fn assert_fn<F: Fn(SEXP) -> bool>(_f: F) {}
159        assert_fn(|s| unsafe { s4_is(s) });
160    }
161
162    #[test]
163    fn s4_class_name_compiles() {
164        fn assert_fn<F: Fn(SEXP) -> Option<String>>(_f: F) {}
165        assert_fn(|s| unsafe { s4_class_name(s) });
166    }
167}
168// endregion
miniextendr_api/s4_helpers.rs

miniextendr_api/
s4_helpers.rs
