Support R6 methods

R/funscanr.R

@@ -358,6 +358,14 @@ scan_usage <- function(
 
     head <- x[[1L]]
     head_name <- if (is.symbol(head)) as.character(head) else NULL
+    member_fun <- .ast_member_fun(head)
+
+    # Member calls (e.g., obj$sample()) are package API methods, not
+    # language-level calls; don't suppress them via stdlib ignore lists.
+    if (!is.null(member_fun)) {
+      acc$unqual_funs <- c(acc$unqual_funs, member_fun)
+      acc$unqual_visit_idx <- c(acc$unqual_visit_idx, acc$visit_idx)
+    }
 
     if (!is.null(head_name)) {
       if (!is.na(fastmatch::fmatch(head_name, ns_ops)) && length(x) >= 3L) {
@@ -497,6 +505,29 @@ scan_usage <- function(
   NULL
 }
 
+.ast_member_fun <- function(head) {
+  if (!is.call(head) || !length(head)) {
+    return(NULL)
+  }
+
+  op <- head[[1L]]
+  if (!is.symbol(op)) {
+    return(NULL)
+  }
+
+  op_name <- as.character(op)
+
+  if (op_name %in% c("$", "@") && length(head) >= 3L) {
+    return(.ast_lit_name(head[[3L]]))
+  }
+
+  if (op_name == "(" && length(head) >= 2L) {
+    return(.ast_member_fun(head[[2L]]))
+  }
+
+  NULL
+}
+
 .ast_get_lib_pkg <- function(call) {
   args <- as.list(call)[-1L]
   if (!length(args)) {

data-raw/sysdata.R

@@ -155,9 +155,58 @@ get_origin <- function(pkg, name) {
   sub("^namespace:", "", origin)
 }
 
-# Extraction: Get exported functions for each package
-.stan_exports <- lapply(.stan_pkgs, function(pkg) {
-  getNamespaceExports(pkg) |>
+is_r6_generator <- function(x) {
+  inherits(x, "R6ClassGenerator")
+}
+
+get_r6_generator <- function(pkg, class_name) {
+  asNamespace(pkg) |>
+    (\(ns) {
+      if (!exists(class_name, envir = ns, inherits = FALSE)) {
+        return(NULL)
+      }
+      get(class_name, envir = ns, inherits = FALSE)
+    })() |>
+    (\(obj) if (is_r6_generator(obj)) obj else NULL)()
+}
+
+collect_r6_methods <- function(pkg, export_names) {
+  ns <- asNamespace(pkg)
+
+  exported_r6 <- export_names |>
+    Filter(
+      \(name) {
+        obj <- tryCatch(getExportedValue(pkg, name), error = function(e) NULL)
+        is_r6_generator(obj)
+      },
+      x = _
+    )
+
+  namespace_r6 <- ls(ns, all.names = TRUE) |>
+    Filter(
+      \(name) {
+        obj <- tryCatch(
+          get(name, envir = ns, inherits = FALSE),
+          error = function(e) NULL
+        )
+        is_r6_generator(obj)
+      },
+      x = _
+    )
+
+  unique(c(exported_r6, namespace_r6)) |>
+    lapply(\(class_name) get_r6_generator(pkg, class_name)) |>
+    Filter(\(gen) !is.null(gen), x = _) |>
+    lapply(\(gen) names(gen$public_methods)) |>
+    unlist(use.names = FALSE) |>
+    (\(methods) methods[!is.na(methods) & nzchar(methods)])() |>
+    unique()
+}
+
+collect_pkg_funs <- function(pkg) {
+  export_names <- getNamespaceExports(pkg)
+
+  exported_funs <- export_names |>
     Filter(
       \(x) {
         is.function(tryCatch(getExportedValue(pkg, x), error = function(e) {
@@ -166,7 +215,13 @@ get_origin <- function(pkg, name) {
       },
       x = _
     )
-}) |>
+
+  r6_methods <- collect_r6_methods(pkg, export_names)
+  unique(c(exported_funs, r6_methods))
+}
+
+# Extraction: Get exported functions for each package
+.stan_exports <- lapply(.stan_pkgs, collect_pkg_funs) |>
   setNames(.stan_pkgs)
 
 # Indexing: Create inverted index (function -> packages)
@@ -189,8 +244,6 @@ keys <- paste0(all_stan_pkgs, "::", all_funs)
 )]
 names(.stan_origin_map) <- keys
 
-.date_generated <- Sys.Date()
-
 save(
   .stan_exports,
   .stan_export_index,
@@ -201,7 +254,6 @@ save(
   .stdlib_funs,
   .stan_pkg_versions,
   .scan_skip_dirs,
-  .date_generated,
   file = "R/sysdata.rda",
   compress = "xz"
 )

tests/testthat/_snaps/funscanr.md

@@ -71,6 +71,31 @@
     attr(,"class")
     [1] "scan_usage"
 
+# scan_usage handles faux_proj directory tree
+
+    {
+      "type": "list",
+      "attributes": {
+        "names": {
+          "type": "character",
+          "attributes": {},
+          "value": ["packages", "functions"]
+        }
+      },
+      "value": [
+        {
+          "type": "character",
+          "attributes": {},
+          "value": ["bayesplot", "brms", "cmdstanr", "loo", "posterior", "projpred", "rstan", "rstanarm", "shinystan"]
+        },
+        {
+          "type": "character",
+          "attributes": {},
+          "value": ["bayesplot::mcmc_acf", "bayesplot::mcmc_areas", "bayesplot::mcmc_intervals", "bayesplot::mcmc_rank_hist", "bayesplot::mcmc_trace", "bayesplot::pp_check", "bayesplot::ppc_bars", "bayesplot::ppc_error_hist", "brms::as_draws", "brms::bf", "brms::brm", "brms::conditional_effects", "brms::get_prior", "brms::mixture", "brms::set_prior", "cmdstanr::cmdstan_model", "cmdstanr::diagnostic_summary", "cmdstanr::draws", "cmdstanr::exe_file", "cmdstanr::pathfinder", "cmdstanr::print", "cmdstanr::read_cmdstan_csv", "cmdstanr::sample", "cmdstanr::summary", "cmdstanr::write_stan_json", "loo::loo", "loo::loo_compare", "posterior::as_draws", "posterior::as_draws_cmdstanr", "posterior::as_draws_df", "posterior::as_draws_matrix", "posterior::ess_bulk", "posterior::ess_tail", "posterior::mcse_mean", "posterior::rhat", "posterior::subset_draws", "posterior::summarise_draws", "projpred::cv_varsel", "rstan::extract", "rstan::stan_model", "rstanarm::logit", "shinystan::launch_shinystan"]
+        }
+      ]
+    }
+
 # scan_usage errors on multiple directories
 
     `path` must be a single directory or a vector of files.

tests/testthat/faux_proj/R/prediction.R

@@ -2,9 +2,17 @@ library(cmdstanr)
 
 model <- cmdstan_model("model.stan")
 fit <- model$sample(data = list(N = 10, y = rnorm(10)))
+model$print()
+model$exe_file()
 
-cmdstanr::cmdstan_model("model2.stan")
-cmdstanr::write_stan_json(list(N = 5, y = rnorm(5)), "data.json")
+fit$draws(format = "df")
+fit$diagnostic_summary()
+fit$summary()
+
+model$pathfinder(data = list(N = 10, y = rnorm(10)), draws = 100)
+
+cmdstan_model("model2.stan")
+write_stan_json(list(N = 5, y = rnorm(5)), "data.json")
 
 posterior::as_draws_cmdstanr(fit)
 posterior::subset_draws(fit, 1:10)