Merge pull request #197 from pharmaverse/163-feature-request-consider…

…-mandatory-lint-for-library-calls-to-be-at-top-of-script

Closes #163, #202

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 bootstarp 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