Some refactoring to clarify logic in complicated linters

NEWS.md

@@ -34,7 +34,7 @@
 * `assignment_linter()` lints the {magrittr} assignment pipe `%<>%` (#2008, @MichaelChirico). This can be deactivated by setting the new argument `allow_pipe_assign` to `TRUE`.
 * `object_usage_linter()`:
   + assumes `glue()` is `glue::glue()` when `interpret_glue=TRUE` (#2032, @MichaelChirico).
-  + finds function usages inside `glue()` calls to avoid false positives for "unused objects" (#2029, @MichaelChirico).
+  + finds function usages, including infix usage, inside `glue()` calls to avoid false positives for "unused objects" (#2029 and #2069, @MichaelChirico).
 * `object_name_linter()` no longer attempts to lint strings in function calls on the LHS of assignments (#1466, @MichaelChirico).
 
 # lintr 3.1.0

R/namespace_linter.R

@@ -123,74 +123,55 @@ namespace_linter <- function(check_exports = TRUE, check_nonexports = TRUE) {
   })
 }
 
-get_all_exports <- function(namespace) {
-  c(getNamespaceExports(namespace), names(.getNamespaceInfo(namespace, "lazydata")))
+exported_symbols <- function(ns) c(getNamespaceExports(ns), names(.getNamespaceInfo(ns, "lazydata")))
+is_exported <- function(symbols, namespaces) {
+  mapply(
+    function(pkg_sym, pkg_ns) pkg_sym %in% exported_symbols(pkg_ns),
+    symbols, namespaces
+  )
 }
 
 build_ns_get_int_lints <- function(packages, symbols, symbol_nodes, namespaces, source_expression) {
-  lints <- list()
-
   ## Case 2: foo does not exist in pkg:::foo
-
-  non_symbols <- !vapply(
-    seq_along(symbols),
-    function(ii) symbols[[ii]] %in% ls(namespaces[[ii]], all.names = TRUE),
-    logical(1L)
+  non_symbols <- !mapply(
+    function(pkg_sym, pkg_ns) pkg_sym %in% ls(pkg_ns, all.names = TRUE),
+    symbols, namespaces
+  )
+  non_symbols_lints <- xml_nodes_to_lints(
+    symbol_nodes[non_symbols],
+    source_expression = source_expression,
+    lint_message = sprintf("'%s' does not exist in {%s}.", symbols[non_symbols], packages[non_symbols]),
+    type = "warning"
   )
-  if (any(non_symbols)) {
-    lints <- c(lints, xml_nodes_to_lints(
-      symbol_nodes[non_symbols],
-      source_expression = source_expression,
-      lint_message = sprintf("'%s' does not exist in {%s}.", symbols[non_symbols], packages[non_symbols]),
-      type = "warning"
-    ))
-
-    packages <- packages[!non_symbols]
-    symbols <- symbols[!non_symbols]
-    symbol_nodes <- symbol_nodes[!non_symbols]
-  }
 
-  ## Case 3: foo is already exported pkg:::foo
+  packages <- packages[!non_symbols]
+  symbols <- symbols[!non_symbols]
+  symbol_nodes <- symbol_nodes[!non_symbols]
+  namespaces <- namespaces[!non_symbols]
 
-  exported <- vapply(
-    seq_along(symbols),
-    function(ii) symbols[[ii]] %in% get_all_exports(namespaces[[ii]]),
-    logical(1L)
+  ## Case 3: foo is already exported pkg:::foo
+  exported <- is_exported(symbols, namespaces)
+  exported_lints <- xml_nodes_to_lints(
+    symbol_nodes[exported],
+    source_expression = source_expression,
+    lint_message =
+      sprintf("'%1$s' is exported from {%2$s}. Use %2$s::%1$s instead.", symbols[exported], packages[exported]),
+    type = "warning"
   )
-  if (any(exported)) {
-    lints <- c(lints, xml_nodes_to_lints(
-      symbol_nodes[exported],
-      source_expression = source_expression,
-      lint_message =
-        sprintf("'%1$s' is exported from {%2$s}. Use %2$s::%1$s instead.", symbols[exported], packages[exported]),
-      type = "warning"
-    ))
-  }
-
-  lints
+
+  c(non_symbols_lints, exported_lints)
 }
 
 build_ns_get_lints <- function(packages, symbols, symbol_nodes, namespaces, source_expression) {
-  lints <- list()
-
   # strip backticked symbols; `%>%` is the same as %>% (#1752).
   symbols <- gsub("^`(.*)`$", "\\1", symbols)
 
   ## Case 4: foo is not an export in pkg::foo
-
-  unexported <- !vapply(
-    seq_along(symbols),
-    function(ii) symbols[[ii]] %in% get_all_exports(namespaces[[ii]]),
-    logical(1L)
+  unexported <- !is_exported(symbols, namespaces)
+  xml_nodes_to_lints(
+    symbol_nodes[unexported],
+    source_expression = source_expression,
+    lint_message = sprintf("'%s' is not exported from {%s}.", symbols[unexported], packages[unexported]),
+    type = "warning"
   )
-  if (any(unexported)) {
-    lints <- c(lints, xml_nodes_to_lints(
-      symbol_nodes[unexported],
-      source_expression = source_expression,
-      lint_message = sprintf("'%s' is not exported from {%s}.", symbols[unexported], packages[unexported]),
-      type = "warning"
-    ))
-  }
-
-  lints
 }