MSRV goes to R 3.6

.github/workflows/R-CMD-check.yaml

@@ -24,6 +24,7 @@ jobs:
           - {os: ubuntu-latest,   r: 'devel', http-user-agent: 'release'}
           - {os: ubuntu-latest,   r: 'release'}
           - {os: ubuntu-latest,   r: 'oldrel-1'}
+          - {os: ubuntu-latest,   r: '3.6'}
 
     env:
       GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }}

DESCRIPTION

@@ -14,7 +14,7 @@ License: MIT + file LICENSE
 URL: https://ascribe.visruth.com
 BugReports: https://github.com/VisruthSK/ascribe/issues
 Depends: 
-    R (>= 4.2.0)
+    R (>= 3.6.0)
 Imports:
     brio,
     cli,

R/cite_usage.R

@@ -41,7 +41,7 @@ cite_usage <- function(
 
   base_pkgs <- if (cite_r) "base" else character()
   entries <- c(
-    lapply(unique(c(pkgs, base_pkgs)), \(pkg) {
+    lapply(unique(c(pkgs, base_pkgs)), function(pkg) {
       entry <- get0(
         pkg,
         envir = package_citations,
@@ -54,13 +54,12 @@ cite_usage <- function(
         entry
       }
     }),
-    lapply(usage$functions, \(fun) {
+    lapply(usage$functions, function(fun) {
       get0(fun, envir = function_citations, inherits = FALSE, ifnotfound = NULL)
     })
-  ) |>
-    Filter(Negate(is.null), x = _) |>
-    do.call(c, args = _) |>
-    unique()
+  )
+
+  entries <- unique(do.call(c, Filter(Negate(is.null), entries)))
 
   if (match.arg(format) == "bibentry") entries else utils::toBibtex(entries)
 }

R/collect.R

@@ -11,15 +11,15 @@
 collect_pkg_funs <- function(pkg) {
   ns <- asNamespace(pkg)
 
-  getNamespaceExports(pkg) |>
+  unique(c(
     Filter(
-      \(x) {
+      function(x) {
         is.function(tryCatch(getExportedValue(ns, x), error = function(e) NULL))
       },
-      x = _
-    ) |>
-    c(collect_r6_methods(pkg)) |>
-    unique()
+      getNamespaceExports(pkg)
+    ),
+    collect_r6_methods(pkg)
+  ))
 }
 
 #' Collect R6 class method names from a package
@@ -33,36 +33,43 @@ collect_pkg_funs <- function(pkg) {
 collect_r6_methods <- function(pkg) {
   ns <- asNamespace(pkg)
 
-  namespace_r6 <- ls(ns, all.names = TRUE) |>
+  namespace_r6 <- Filter(
+    Negate(is.null),
     lapply(
-      \(name) {
+      ls(ns, all.names = TRUE),
+      function(name) {
         obj <- tryCatch(
           get0(name, envir = ns, inherits = FALSE),
           error = function(e) NULL
         )
         if (inherits(obj, "R6ClassGenerator")) obj else NULL
       }
-    ) |>
-    Filter(Negate(is.null), x = _)
+    )
+  )
 
-  exported_r6 <- getNamespaceExports(ns) |>
+  exported_r6 <- Filter(
+    Negate(is.null),
     lapply(
-      \(name) {
+      getNamespaceExports(ns),
+      function(name) {
         obj <- tryCatch(
           getExportedValue(ns, name),
           error = function(e) NULL
         )
         if (inherits(obj, "R6ClassGenerator")) obj else NULL
       }
-    ) |>
-    Filter(Negate(is.null), x = _)
+    )
+  )
 
-  c(namespace_r6, exported_r6) |>
-    lapply(\(gen) names(gen$public_methods)) |>
-    unlist(use.names = FALSE) |>
-    as.character() |>
-    (\(methods) methods[!is.na(methods) & nzchar(methods)])() |>
-    unique()
+  methods <- unlist(
+    lapply(
+      c(namespace_r6, exported_r6),
+      function(gen) names(gen$public_methods)
+    ),
+    use.names = FALSE
+  )
+  methods <- as.character(methods)
+  unique(methods[!is.na(methods) & nzchar(methods)])
 }
 
 .resolve_origin_ns <- function(ns, name) {
@@ -151,7 +158,9 @@ build_origin_map <- function(exports) {
 
   u_pkgs <- unique(all_pkgs)
   ns_list <- stats::setNames(
-    lapply(u_pkgs, \(p) tryCatch(asNamespace(p), error = function(e) NULL)),
+    lapply(u_pkgs, function(p) {
+      tryCatch(asNamespace(p), error = function(e) NULL)
+    }),
     u_pkgs
   )
 

R/scan_usage.R

@@ -93,7 +93,7 @@ scan_usage <- function(
     }
     lapply(
       paths,
-      \(file_path) cli::cli_alert_info("Searching {.path {file_path}}")
+      function(file_path) cli::cli_alert_info("Searching {.path {file_path}}")
     )
     paths
   }
@@ -116,7 +116,7 @@ scan_usage <- function(
 
   hits <- lapply(
     unique(files),
-    \(file) {
+    function(file) {
       code_str <- .extract_code(
         file,
         skip_patterns = skip_patterns,
@@ -216,11 +216,7 @@ scan_usage <- function(
 }
 
 .collect_unique <- function(hits, field) {
-  hits |>
-    lapply(`[[`, field) |>
-    unlist(use.names = FALSE) |>
-    unique() |>
-    sort()
+  sort(unique(unlist(lapply(hits, `[[`, field), use.names = FALSE)))
 }
 
 # Chunks pkgs into word-boundary alternation regexes (PCRE limits how many
@@ -239,7 +235,7 @@ scan_usage <- function(
   )
   vapply(
     chunks,
-    \(chk) {
+    function(chk) {
       escaped <- gsub("([][{}()+*^$|\\\\.?])", "\\\\\\1", chk)
       paste0("\\b(", paste(escaped, collapse = "|"), ")\\b")
     },
@@ -266,7 +262,9 @@ scan_usage <- function(
 
   lapply(
     metapackages,
-    \(pkgs) unique(pkgs[!is.na(fastmatch::fmatch(pkgs, allowed_packages))])
+    function(pkgs) {
+      unique(pkgs[!is.na(fastmatch::fmatch(pkgs, allowed_packages))])
+    }
   )
 }
 
@@ -280,9 +278,7 @@ scan_usage <- function(
   skip_patterns = NULL,
   use_knitr = FALSE
 ) {
-  ext <- file |>
-    sub(".*\\.", "", x = _) |>
-    tolower()
+  ext <- tolower(sub(".*\\.", "", file))
 
   if (!ext %in% c("r", "rmd", "qmd")) {
     cli::cli_abort(c(
@@ -462,7 +458,7 @@ scan_usage <- function(
       c,
       lapply(
         code,
-        \(chunk) {
+        function(chunk) {
           tryCatch(
             parse(text = chunk, keep.source = FALSE),
             error = function(e) NULL
@@ -938,7 +934,7 @@ scan_usage <- function(
     cbind,
     lapply(
       meta$provider,
-      \(pkg) {
+      function(pkg) {
         provider_rows <- attached_rows[[pkg]]
         hits <- findInterval(visit_idx, attached$visit_idx[provider_rows])
         out <- rep.int(-1L, length(visit_idx))

R/universe.R

@@ -33,7 +33,7 @@ build_universe_data <- function(packages) {
   origin_map <- build_origin_map(exports)
 
   pkg_versions <- stats::setNames(
-    lapply(packages, \(p) as.character(utils::packageVersion(p))),
+    lapply(packages, function(p) as.character(utils::packageVersion(p))),
     packages
   )
 

data-raw/sysdata.R

@@ -5,13 +5,13 @@
 # - .scan_skip_dirs: directory names to skip when scanning projects
 
 # Precompute standard library functions
-.stdlib_funs <- lapply(
-  c("base", "stats", "utils", "graphics", "grDevices", "methods"),
-  getNamespaceExports
-) |>
-  unlist(use.names = FALSE) |>
-  unique() |>
-  sort()
+.stdlib_funs <- sort(unique(unlist(
+  lapply(
+    c("base", "stats", "utils", "graphics", "grDevices", "methods"),
+    getNamespaceExports
+  ),
+  use.names = FALSE
+)))
 
 # Default skip directories
 .scan_skip_dirs <- c(

tests/testthat/fixtures/ascribetestbroken/DESCRIPTION

@@ -0,0 +1,7 @@
+Package: ascribetestbroken
+Version: 0.0.1
+Title: Test Fixture for Ascribe Broken Namespace Handling
+Description: Minimal package with an erroring active binding.
+Authors@R: person("Ascribe", "Tests", email = "tests@ascribe.test", role = c("aut", "cre"))
+License: MIT
+Imports: R6

tests/testthat/fixtures/ascribetestbroken/NAMESPACE

@@ -0,0 +1 @@
+export(SomeClass)

tests/testthat/fixtures/ascribetestbroken/R/code.R

@@ -0,0 +1,12 @@
+# jarl-ignore unused_function: package load hook called by R
+.onLoad <- function(libname, pkgname) {
+  ns <- asNamespace(pkgname)
+  makeActiveBinding("broken", function() stop("boom"), env = ns)
+}
+
+SomeClass <- R6::R6Class(
+  "SomeClass",
+  public = list(
+    method = function() "upstream"
+  )
+)

tests/testthat/fixtures/ascribetestdownstreamr6/DESCRIPTION

@@ -0,0 +1,7 @@
+Package: ascribetestdownstreamr6
+Version: 0.0.1
+Title: Test Fixture for Ascribe R6 Re-export Handling
+Description: Minimal downstream package for testing R6 re-export detection.
+Authors@R: person("Ascribe", "Tests", email = "tests@ascribe.test", role = c("aut", "cre"))
+License: MIT
+Imports: ascribetestupstreamr6

tests/testthat/fixtures/ascribetestdownstreamr6/NAMESPACE

@@ -0,0 +1,2 @@
+importFrom(ascribetestupstreamr6, ExportedClass)
+export(ExportedClass)

tests/testthat/fixtures/ascribetestupstreamr6/DESCRIPTION

@@ -0,0 +1,7 @@
+Package: ascribetestupstreamr6
+Version: 0.0.1
+Title: Test Fixture for Ascribe R6 Discovery
+Description: Minimal package with exported and internal R6 classes for testing collect_r6_methods.
+Authors@R: person("Ascribe", "Tests", email = "tests@ascribe.test", role = c("aut", "cre"))
+License: MIT
+Imports: R6

tests/testthat/fixtures/ascribetestupstreamr6/NAMESPACE

@@ -0,0 +1 @@
+export(ExportedClass)

tests/testthat/fixtures/ascribetestupstreamr6/R/classes.R

@@ -0,0 +1,13 @@
+ExportedClass <- R6::R6Class(
+  "ExportedClass",
+  public = list(
+    exported_method = function() "exported"
+  )
+)
+
+InternalClass <- R6::R6Class(
+  "InternalClass",
+  public = list(
+    internal_method = function() "internal"
+  )
+)

tests/testthat/setup.R

@@ -1,5 +1,44 @@
 options(cli.default_handler = function(msg) invisible(NULL))
 
+# Single fixture installation helper - accepts one or more fixture names
+with_fixtures <- function(fixture_names, code) {
+  skip_if_not_installed("R6")
+
+  tmp_lib <- tempfile()
+  dir.create(tmp_lib)
+  old_lib <- .libPaths()
+
+  on.exit(
+    {
+      # Unload fixture namespaces in reverse order
+      for (pkg in rev(fixture_names)) {
+        if (isNamespaceLoaded(pkg)) {
+          unloadNamespace(pkg)
+        }
+      }
+      .libPaths(old_lib)
+      unlink(tmp_lib, recursive = TRUE)
+    },
+    add = TRUE
+  )
+
+  .libPaths(c(tmp_lib, old_lib))
+
+  for (fixture_name in fixture_names) {
+    fixture_dir <- testthat::test_path("fixtures", fixture_name)
+    utils::install.packages(
+      fixture_dir,
+      repos = NULL,
+      type = "source",
+      lib = tmp_lib,
+      INSTALL_opts = c("--no-staged-install", "--no-test-load"),
+      quiet = TRUE
+    )
+  }
+
+  code()
+}
+
 test_universe <- function(packages, export_index = list(), origin_map = NULL) {
   if (is.null(origin_map)) {
     origin_map <- new.env(parent = emptyenv())