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::ffi::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::ffi::{self, SEXP, SexpExt};
33use std::ffi::CStr;
34
35/// Get the `methods` package namespace for evaluating S4 functions.
36///
37/// # Safety
38///
39/// Must be called from the R main thread.
40unsafe fn methods_namespace() -> Result<REnv, String> {
41    unsafe { REnv::package_namespace("methods") }
42}
43
44/// Check if a SEXP is an S4 object.
45///
46/// # Safety
47///
48/// - `obj` must be a valid SEXP.
49/// - Must be called from the R main thread.
50#[inline]
51pub unsafe fn s4_is(obj: SEXP) -> bool {
52    obj.is_s4()
53}
54
55/// Check if an S4 object has a named slot.
56///
57/// Attempts to access the slot via [`s4_get_slot`]. Returns `true` if the
58/// slot exists and is accessible, `false` if accessing it errors (i.e.,
59/// the slot does not exist).
60///
61/// # Safety
62///
63/// - `obj` must be a valid SEXP (typically an S4 object).
64/// - Must be called from the R main thread.
65pub unsafe fn s4_has_slot(obj: SEXP, slot_name: &str) -> bool {
66    unsafe { s4_get_slot(obj, slot_name).is_ok() }
67}
68
69/// Get the value of a named slot from an S4 object.
70///
71/// Uses R's `slot(obj, name)` to access the slot value.
72///
73/// # Safety
74///
75/// - `obj` must be a valid S4 SEXP with the named slot.
76/// - Must be called from the R main thread.
77///
78/// # Returns
79///
80/// - `Ok(SEXP)` with the slot value (unprotected).
81/// - `Err(String)` if the slot doesn't exist or another R error occurs.
82pub unsafe fn s4_get_slot(obj: SEXP, slot_name: &str) -> Result<SEXP, String> {
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(String)` if the slot doesn't exist or the value type is incompatible.
106pub unsafe fn s4_set_slot(obj: SEXP, slot_name: &str, value: SEXP) -> Result<(), String> {
107    unsafe {
108        // slot(obj, name) <- value  is equivalent to `slot<-`(obj, name, value)
109        let env = methods_namespace()?;
110        RCall::new("slot<-")
111            .arg(obj)
112            .named_arg("name", scalar_string(slot_name))
113            .named_arg("value", value)
114            .eval(env.as_sexp())?;
115        Ok(())
116    }
117}
118
119/// Extract the S4 class name from an object.
120///
121/// Reads the `class` attribute and returns the first element as a `String`.
122/// Returns `None` if the object has no class attribute or the attribute is empty.
123///
124/// # Safety
125///
126/// - `obj` must be a valid SEXP.
127/// - Must be called from the R main thread.
128pub unsafe fn s4_class_name(obj: SEXP) -> Option<String> {
129    unsafe {
130        let class_attr = obj.get_class();
131        if class_attr.is_null_or_nil() || ffi::Rf_xlength(class_attr) == 0 {
132            return None;
133        }
134
135        let first = class_attr.string_elt(0);
136        if first.is_null_or_nil() {
137            return None;
138        }
139
140        let ptr = first.r_char();
141        if ptr.is_null() {
142            return None;
143        }
144
145        Some(CStr::from_ptr(ptr).to_string_lossy().into_owned())
146    }
147}
148
149// region: Internal helpers
150
151/// Create a scalar R character string from a Rust `&str`.
152///
153/// The returned SEXP is unprotected — caller must protect if further
154/// allocations will occur before use.
155#[inline]
156fn scalar_string(s: &str) -> SEXP {
157    SEXP::scalar_string_from_str(s)
158}
159
160#[cfg(test)]
161mod tests {
162    use super::*;
163
164    #[test]
165    fn s4_is_compiles() {
166        // Verify the function signature compiles.
167        // Actual testing requires the R runtime.
168        fn assert_fn<F: Fn(SEXP) -> bool>(_f: F) {}
169        assert_fn(|s| unsafe { s4_is(s) });
170    }
171
172    #[test]
173    fn s4_class_name_compiles() {
174        fn assert_fn<F: Fn(SEXP) -> Option<String>>(_f: F) {}
175        assert_fn(|s| unsafe { s4_class_name(s) });
176    }
177}
178// endregion
miniextendr_api/s4_helpers.rs

miniextendr_api/
s4_helpers.rs
