v0.3.0

.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 }}
@@ -38,6 +39,7 @@ jobs:
         with:
           r-version: ${{ matrix.config.r }}
           http-user-agent: ${{ matrix.config.http-user-agent }}
+          use-public-rspm: true
 
       - uses: r-lib/actions/setup-r-dependencies@v2
         with:
@@ -47,4 +49,4 @@ jobs:
       - uses: r-lib/actions/check-r-package@v2
         with:
           upload-snapshots: true
-          build_args: 'c("--no-manual","--compact-vignettes=gs+qpdf")'
+          build_args: 'c("--no-manual","--compact-vignettes=gs+qpdf")'

.github/workflows/pkgdown.yaml

@@ -29,7 +29,10 @@ jobs:
 
       - uses: r-lib/actions/setup-r@v2
         with:
-          extra-repositories: https://visruthsk.r-universe.dev
+          use-public-rspm: true
+          extra-repositories: |
+            https://community.r-multiverse.org
+            https://visruthsk.r-universe.dev
 
       - uses: r-lib/actions/setup-r-dependencies@v2
         with:
@@ -46,4 +49,4 @@ jobs:
         with:
           clean: false
           branch: gh-pages
-          folder: docs
+          folder: docs

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: ascribe
 Title: Static Detection and Citation of R Package and Function Usage
-Version: 0.2.0.9000
+Version: 0.3.0
 Authors@R: 
     person("Visruth", "Srimath Kandali", , "public@visruth.com", role = c("aut", "cre", "cph"),
            comment = c(ORCID = "0009-0005-9097-0688"))
@@ -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

@@ -13,6 +13,8 @@
 #' @param always_cite Character vector of packages to cite in addition to the
 #'   packages found by the scan.
 #' @param format One of `"bibtex"` or `"bibentry"`.
+#' @param cite_r Whether to include an automatic R base citation. Defaults
+#'   to `TRUE`.
 #' @return A BibTeX character vector or a bibentry object.
 #' @export
 #' @examples
@@ -21,22 +23,25 @@
 #' universe <- build_universe_data(c("cli", "fastmatch"))
 #' usage <- scan_usage(path, universe)
 #' cite_usage(usage)
+#' cite_usage(usage, cite_r = FALSE)
 #' unlink(path)
 cite_usage <- function(
   usage,
   package_citations = new.env(parent = emptyenv(), hash = TRUE),
   function_citations = new.env(parent = emptyenv(), hash = TRUE),
   package_citation = utils::citation,
   always_cite = character(),
-  format = c("bibtex", "bibentry")
+  format = c("bibtex", "bibentry"),
+  cite_r = TRUE
 ) {
   pkgs <- unique(c(usage$packages, always_cite))
   if (!length(pkgs) && !length(usage$functions)) {
     return(character())
   }
 
+  base_pkgs <- if (cite_r) "base" else character()
   entries <- c(
-    lapply(unique(c(pkgs, "base")), \(pkg) {
+    lapply(unique(c(pkgs, base_pkgs)), function(pkg) {
       entry <- get0(
         pkg,
         envir = package_citations,
@@ -49,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,
@@ -130,7 +130,8 @@ scan_usage <- function(
         metapackages = metapackages,
         walker = walker,
         file_path = file,
-        skip_patterns = if (is_r) NULL else skip_patterns
+        skip_patterns = if (is_r) NULL else skip_patterns,
+        explicit_only = !is.null(metapackages) && length(metapackages) > 0L
       )
     }
   )
@@ -215,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
@@ -238,7 +235,7 @@ scan_usage <- function(
   )
   vapply(
     chunks,
-    \(chk) {
+    function(chk) {
       escaped <- gsub("([][{}()+*^$|\\\\.?])", "\\\\\\1", chk)
       paste0("\\b(", paste(escaped, collapse = "|"), ")\\b")
     },
@@ -265,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))])
+    }
   )
 }
 
@@ -279,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(
@@ -437,7 +434,11 @@ scan_usage <- function(
   metapackages,
   walker,
   file_path,
-  skip_patterns = .build_skip_patterns(c(allowed_packages, names(metapackages)))
+  skip_patterns = .build_skip_patterns(c(
+    allowed_packages,
+    names(metapackages)
+  )),
+  explicit_only = FALSE
 ) {
   empty <- list(pkgs = character(), keys = character(), ambiguous = character())
   if (!any(nzchar(code))) {
@@ -457,7 +458,7 @@ scan_usage <- function(
       c,
       lapply(
         code,
-        \(chunk) {
+        function(chunk) {
           tryCatch(
             parse(text = chunk, keep.source = FALSE),
             error = function(e) NULL
@@ -486,6 +487,7 @@ scan_usage <- function(
   acc$lib_pkgs <- character()
   acc$lib_visit_idx <- integer()
   acc$lib_is_attach <- logical()
+  acc$lib_is_explicit <- logical()
   acc$ns_pkgs <- character()
   acc$ns_keys <- character()
   acc$unqual_funs <- character()
@@ -499,7 +501,8 @@ scan_usage <- function(
     list(
       visit_idx = acc$lib_visit_idx,
       pkg = acc$lib_pkgs,
-      is_attach = acc$lib_is_attach
+      is_attach = acc$lib_is_attach,
+      is_explicit = acc$lib_is_explicit
     )
   } else {
     NULL
@@ -520,8 +523,14 @@ scan_usage <- function(
     resolver_index = resolver_index
   )
 
+  explicit_pkgs <- if (explicit_only) {
+    lib_data$pkg[lib_data$is_explicit]
+  } else {
+    lib_data$pkg[lib_data$is_attach]
+  }
+
   list(
-    pkgs = c(acc$lib_pkgs, acc$ns_pkgs, resolved$pkgs),
+    pkgs = c(explicit_pkgs, acc$ns_pkgs, resolved$pkgs),
     keys = c(acc$ns_keys, resolved$keys),
     ambiguous = resolved$ambiguous
   )
@@ -597,25 +606,37 @@ scan_usage <- function(
           if (!is.null(pkg)) {
             is_allowed <- !is.null(allowed_pkgs_env[[pkg]])
             is_attach <- kind == 3L
+            is_metapkg <- !is.null(metapackages) &&
+              !is.null(metapackages[[pkg]])
 
-            if (is_allowed) {
+            if (is_allowed || is_metapkg) {
               acc$lib_pkgs <- c(acc$lib_pkgs, pkg)
               acc$lib_visit_idx <- c(acc$lib_visit_idx, acc$visit_idx)
               acc$lib_is_attach <- c(acc$lib_is_attach, is_attach)
+              acc$lib_is_explicit <- c(acc$lib_is_explicit, is_attach)
             }
 
             if (is_attach && !is.null(metapackages)) {
               expanded_pkgs <- metapackages[[pkg]]
               if (length(expanded_pkgs)) {
-                acc$lib_pkgs <- c(acc$lib_pkgs, expanded_pkgs)
-                acc$lib_visit_idx <- c(
-                  acc$lib_visit_idx,
-                  rep.int(acc$visit_idx, length(expanded_pkgs))
-                )
-                acc$lib_is_attach <- c(
-                  acc$lib_is_attach,
-                  rep.int(TRUE, length(expanded_pkgs))
-                )
+                allowed_expanded <- expanded_pkgs[
+                  !is.na(fastmatch::fmatch(expanded_pkgs, allowed_packages))
+                ]
+                if (length(allowed_expanded)) {
+                  acc$lib_pkgs <- c(acc$lib_pkgs, allowed_expanded)
+                  acc$lib_visit_idx <- c(
+                    acc$lib_visit_idx,
+                    rep.int(acc$visit_idx, length(allowed_expanded))
+                  )
+                  acc$lib_is_attach <- c(
+                    acc$lib_is_attach,
+                    rep.int(TRUE, length(allowed_expanded))
+                  )
+                  acc$lib_is_explicit <- c(
+                    acc$lib_is_explicit,
+                    rep.int(FALSE, length(allowed_expanded))
+                  )
+                }
               }
             }
           }
@@ -913,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
   )