Merge branch 'dev' into 159-185-blank-line-spellcheck

DESCRIPTION

@@ -50,7 +50,6 @@ Imports:
  waiter,
  tibble,
  digest,
- lintr,
  lifecycle
 Suggests: 
  testthat (>= 3.0.0),
@@ -61,6 +60,8 @@ Suggests:
  pkgdown,
  Tplyr,
  haven,
+ lintr,
+ xml2,
  here
 VignetteBuilder: knitr
 Config/testthat/edition: 3

NAMESPACE

@@ -17,7 +17,6 @@ importFrom(dplyr,group_by)
 importFrom(dplyr,mutate)
 importFrom(dplyr,select)
 importFrom(dplyr,ungroup)
-importFrom(lintr,lint)
 importFrom(magrittr,"%>%")
 importFrom(miniUI,gadgetTitleBar)
 importFrom(miniUI,miniContentPanel)

NEWS.md

@@ -1,8 +1,10 @@
 # logrx 0.3.0
 
+- Moved website theme to bootstrap 5, enabled search (#179)
 - Add `show_repo_url` option in `axecute()` to capture repo URL(s) into log file (#167)
 - Moved website theme to Bootstrap 5, enabled search (#179)
 - Add `include_rds` argument to `axecute()` to export log as rds file
+- Add `library_call_linter()` to ensure all library calls are at the top of the script (#163)
 - Remove argument for remove_log_object from `axecute()` still accessible via `log_write()` (#182)
 
 # logrx 0.2.2

R/get.R

@@ -278,16 +278,22 @@ get_unapproved_use <- function(approved_packages, used_packages) {
 #'
 #' @param file File path of file being run
 #'
-#' @importFrom lintr lint
-#'
 #' @return results from `lintr::lint()`
 #'
 #' @noRd
 #'
 get_lint_results <- function(file) {
+
+ if (!requireNamespace("lintr", quietly = TRUE)) {
+ message(strwrap("Linting will not be included in the log. Install the
+ lintr package to use the log.rx.lint feature.",
+ prefix = " ", initial = ""))
+ return()
+ }
+
  # lint file if option is turned on
  if (!is.logical(getOption('log.rx.lint'))) {
- lint(file, getOption('log.rx.lint'))
+ lintr::lint(file, getOption('log.rx.lint'))
  }
 }
 

R/library_call_linter.R

@@ -0,0 +1,88 @@
+#' Library call linter
+#'
+#' Force library calls to all be at the top of the script.
+#'
+#' @examples
+#' library(lintr)
+#'
+#' # will produce lints
+#' lint(
+#' text = "
+#' library(dplyr)
+#' print('test')
+#' library(tidyr)
+#' ",
+#' linters = library_call_linter()
+#' )
+#'
+#' lint(
+#' text = "
+#' library(dplyr)
+#' print('test')
+#' library(tidyr)
+#' library(purrr)
+#' ",
+#' linters = library_call_linter()
+#' )
+#'
+#' # okay
+#' lint(
+#' text = "
+#' library(dplyr)
+#' print('test')
+#' ",
+#' linters = library_call_linter()
+#' )
+#'
+#' lint(
+#' text = "
+#' # comment
+#' library(dplyr)
+#' ",
+#' linters = library_call_linter()
+#' )
+#'
+#' @noRd
+library_call_linter <- function() {
+
+ if (!requireNamespace("lintr", quietly = TRUE)) {
+ warning(strwrap("Library calls will not be checked to confirm all are at
+ the top of the script. Install the lintr package to use this feature.",
+ prefix = " ", initial = ""))
+ return(list())
+ }
+ if (!requireNamespace("xml2", quietly = TRUE)) {
+ warning(strwrap("Library calls will not be checked to confirm all are at
+ the top of the script. Install the xml2 package to use this feature.",
+ prefix = " ", initial = ""))
+ return(list())
+ }
+
+ xpath <- "
+ (//SYMBOL_FUNCTION_CALL[text() = 'library'])[last()]
+ /preceding::expr
+ /SYMBOL_FUNCTION_CALL[text() != 'library'][last()]
+ /following::expr[SYMBOL_FUNCTION_CALL[text() = 'library']]
+ "
+
+ lintr::Linter(function(source_expression) {
+ if (!lintr::is_lint_level(source_expression, "file")) {
+ return(list())
+ }
+
+ xml <- source_expression$full_xml_parsed_content
+
+ bad_expr <- xml2::xml_find_all(xml, xpath)
+
+ if (length(bad_expr) == 0L) {
+ return(list())
+ }
+
+ lintr::xml_nodes_to_lints(
+ bad_expr,
+ source_expression = source_expression,
+ lint_message = "Move all library calls to the top of the script.",
+ type = "warning"
+ )
+ })
+}

R/writer.R

@@ -297,6 +297,10 @@ write_result <- function() {
 write_lint_results <- function(){
  lint_results <- get_log_element("lint_results")
 
+ if (length(lint_results) == 0) {
+ return("")
+ }
+
  lint_df <- as.data.frame(lint_results)
 
  lint_df$lint_messages <- paste0("Line ",

tests/testthat/ref/ex7.R

@@ -0,0 +1,8 @@
+# testing for lint
+library(dplyr)
+
+print('test')
+
+library(purrr)
+
+d <<- 2

tests/testthat/test-get.R

@@ -142,19 +142,58 @@ test_that("parse does not fatal error when syntax issue occurs", {
  expect_identical(get_used_functions(filename), expected)
 })
 
-test_that("lint returns expected result when option is set", {
+test_that("lint returns expected result when using the default log.rx.lint option", {
+ skip_if_not_installed("lintr")
+
+ options("log.rx" = NULL)
+ filename <- test_path("ref", "ex7.R")
+
+ # get is called within log_config
+ log_config(filename)
+
+ expect_identical(get_lint_results(filename), NULL)
+})
+
+test_that("lint returns expected result when option is changed", {
+ skip_if_not_installed("lintr")
+
  filename <- test_path("ref", "ex6.R")
  source(filename, local = TRUE)
 
- expected <- lint(filename, c(lintr::undesirable_operator_linter()))
+ expected <- lintr::lint(filename, c(lintr::undesirable_operator_linter()))
 
  withr::local_options(log.rx.lint = c(lintr::undesirable_operator_linter()))
 
  expect_identical(get_lint_results(filename), expected)
 })
 
-test_that("lint returns expected result when option is not set", {
+test_that("library lint returns expected result when multiple linters are set", {
+ skip_if_not_installed("lintr")
+ skip_if_not_installed("xml2")
+
+ options("log.rx" = NULL)
+ withr::local_options(log.rx.lint = c(library_call_linter(), lintr::undesirable_operator_linter()))
+ filename <- test_path("ref", "ex7.R")
+
+ # get is called within log_config
+ log_config(filename)
+
+ expected <- paste0(
+ "Line 6 [library_call_linter] Move all library calls to the ",
+ "top of the script.\n\nLine 8 [undesirable_operator_linter] Operator ",
+ "`<<-` is undesirable. It\nassigns outside the current environment in a ",
+ "way that can be hard to reason\nabout. Prefer fully-encapsulated ",
+ "functions wherever possible, or, if\nnecessary, assign to a specific ",
+ "environment with assign(). Recall that you\ncan create an environment ",
+ "at the desired scope with new.env()."
+ )
+
+ expect_identical(write_lint_results(), expected)
+})
+
+test_that("lint returns expected result when option is set to FALSE", {
  filename <- test_path("ref", "ex6.R")
+ withr::local_options(log.rx.lint = FALSE)
  source(filename, local = TRUE)
 
  expect_identical(get_lint_results(filename), NULL)

tests/testthat/test-writer.R

@@ -183,6 +183,8 @@ test_that("write_result will return a formatted log result element", {
 })
 
 test_that("write_lint_results will return a formatted lint results element", {
+ skip_if_not_installed("lintr")
+
  filename <- test_path("ref", "ex6.R")
  source(filename, local = TRUE)
 
@@ -210,3 +212,22 @@ test_that("write_lint_results will return a formatted lint results element", {
 
  log_remove()
 })
+
+test_that("write_lint_results works when linter is used but no lints found", {
+ skip_if_not_installed("lintr")
+ skip_if_not_installed("xml2")
+
+ filename <- test_path("ref", "ex6.R")
+ source(filename, local = TRUE)
+
+ options("log.rx" = NULL)
+ log_config(filename)
+ lint_results <- lintr::lint(filename, c(library_call_linter()))
+ assign('lint_results', lint_results, envir = getOption('log.rx'))
+
+ expect_identical(
+ write_lint_results(),
+ ""
+ )
+})
+

vignettes/options.Rmd

@@ -51,6 +51,10 @@ If you or your organization would like to implement any linters, you can set you
 
 <br>
 
+It is recommended to use the `library_call_linter()`. This is to ensure `logrx` will find the correct package and functions used.
+
+<br>
+
 Hester J, Angly F, Hyde R, Chirico M, Ren K, Rosenstock A, Patil I (2022). lintr: A 'Linter' for R Code. <https://github.com/r-lib/lintr>, <https://lintr.r-lib.org>.
 
 ## log.rx.approved