From 9c49c6ec5efb4632616f0973747d2cc578ed5655 Mon Sep 17 00:00:00 2001 From: Michael Chirico Date: Tue, 3 Oct 2023 08:30:09 -0700 Subject: [PATCH] allow config to be an .R file (#2177) --- NEWS.md | 1 + R/methods.R | 4 +- R/settings.R | 65 ++++++++++++------- R/settings_utils.R | 8 ++- R/use_lintr.R | 2 +- R/utils.R | 2 +- R/zzz.R | 18 ++++- man/read_settings.Rd | 11 +++- .../dummy_packages/RConfig/DESCRIPTION | 3 + .../dummy_packages/RConfig/R/lint_me.R | 8 +++ .../RConfig/lintr_test_config.R | 6 ++ .../RConfig/lintr_test_config_conflict | 6 ++ .../RConfig/lintr_test_config_conflict.R | 6 ++ .../RConfig/lintr_test_config_extraneous.R | 12 ++++ .../dummy_packages/RConfig/tests/testthat.R | 8 +++ .../dummy_packages/RConfigInvalid/DESCRIPTION | 3 + .../dummy_packages/RConfigInvalid/R/lint_me.R | 1 + .../RConfigInvalid/lintr_test_config.R | 2 + tests/testthat/test-lint_package.R | 47 ++++++++++++++ 19 files changed, 179 insertions(+), 34 deletions(-) create mode 100644 tests/testthat/dummy_packages/RConfig/DESCRIPTION create mode 100644 tests/testthat/dummy_packages/RConfig/R/lint_me.R create mode 100644 tests/testthat/dummy_packages/RConfig/lintr_test_config.R create mode 100644 tests/testthat/dummy_packages/RConfig/lintr_test_config_conflict create mode 100644 tests/testthat/dummy_packages/RConfig/lintr_test_config_conflict.R create mode 100644 tests/testthat/dummy_packages/RConfig/lintr_test_config_extraneous.R create mode 100644 tests/testthat/dummy_packages/RConfig/tests/testthat.R create mode 100644 tests/testthat/dummy_packages/RConfigInvalid/DESCRIPTION create mode 100644 tests/testthat/dummy_packages/RConfigInvalid/R/lint_me.R create mode 100644 tests/testthat/dummy_packages/RConfigInvalid/lintr_test_config.R diff --git a/NEWS.md b/NEWS.md index f7b109e76..3dcbce75c 100644 --- a/NEWS.md +++ b/NEWS.md @@ -17,6 +17,7 @@ * Toggle lint progress indicators with argument `show_progress` to `lint_dir()` and `lint_package()` (#972, @MichaelChirico). The default is still to show progress in `interactive()` sessions. Progress is also now shown with a "proper" progress bar (`utils::txtProgressBar()`), which in particular solves the issue of progress `.` spilling well past the width of the screen in large directories. * `lint()`, `lint_dir()`, and `lint_package()` fail more gracefully when the user mis-spells an argument name (#2134, @MichaelChirico). * Quarto files (.qmd) are included by `lint_dir()` by default (#2150, @dave-lovell). +* There is experimental support for writing config in plain R scripts (as opposed to DCF files; #1210, @MichaelChirico). The script is run in a new environment and variables matching settings (`?default_settings`) are copied over. In particular, this removes the need to write R code in a DCF-friendly way, and allows normal R syntax highlighting in the saved file. We may eventually deprecate the DCF approach in favor of this one; user feedback is welcome on strong preferences for either approach, or for a different approach like YAML. Generally you should be able to convert your existing `.lintr` file to an equivalent R config by replacing the `:` key-value separators with assignments (`<-`). By default, such a config is searched for in a file named '.lintr.R'. * `fixed_regex_linter()` + Is pipe-aware, in particular removing false positives around piping into {stringr} functions like `x |> str_replace(fixed("a"), "b")` (#1811, @MichaelChirico). + Gains an option `allow_unescaped` (default `FALSE`) to toggle linting regexes not requiring any escapes or character classes (#1689, @MichaelChirico). Thus `fixed_regex_linter(allow_unescaped = TRUE)` would lint on `grepl("[$]", x)` but not on `grepl("a", x)` since the latter does not use any regex special characters. diff --git a/R/methods.R b/R/methods.R index a7a531617..13b67daa0 100644 --- a/R/methods.R +++ b/R/methods.R @@ -74,11 +74,11 @@ format.lints <- function(x, ...) { #' @export print.lints <- function(x, ...) { - use_rstudio_source_markers <- getOption("lintr.rstudio_source_markers", TRUE) && + use_rstudio_source_markers <- lintr_option("rstudio_source_markers", TRUE) && requireNamespace("rstudioapi", quietly = TRUE) && rstudioapi::hasFun("sourceMarkers") - github_annotation_project_dir <- getOption("lintr.github_annotation_project_dir", "") + github_annotation_project_dir <- lintr_option("github_annotation_project_dir", "") if (length(x) > 0L) { inline_data <- x[[1L]][["filename"]] == "" diff --git a/R/settings.R b/R/settings.R index c7ca974e9..8addc45e7 100644 --- a/R/settings.R +++ b/R/settings.R @@ -9,7 +9,17 @@ #' #' The default linter_file name is `.lintr` but it can be changed with option `lintr.linter_file` #' or the environment variable `R_LINTR_LINTER_FILE` -#' This file is a dcf file, see [base::read.dcf()] for details. +#' This file is a DCF file, see [base::read.dcf()] for details. +#' Experimentally, we also support keeping the config in a plain R file. By default we look for +#' a file named '.lintr.R' (in the same directories where we search for '.lintr'). +#' We are still deciding the future of config support in lintr, so user feedback is welcome. +#' The advantage of R is that it maps more closely to how the configs are actually stored, +#' whereas the DCF approach requires somewhat awkward formatting of parseable R code within +#' valid DCF key-value pairs. The main disadvantage of the R file is it might be _too_ flexible, +#' with users tempted to write configs with side effects causing hard-to-detect bugs or +#" otherwise "abusing" the ability to evaluate generic R code. Other recursive key-value stores +#' like YAML could work, but require new dependencies and are harder to parse +#' both programmatically and visually. #' @param filename source file to be linted read_settings <- function(filename) { reset_settings() @@ -21,18 +31,7 @@ read_settings <- function(filename) { default_settings[["encoding"]] <- default_encoding } - if (!is.null(config_file)) { - malformed <- function(e) { - stop("Malformed config file, ensure it ends in a newline\n ", conditionMessage(e), call. = FALSE) - } - config <- tryCatch( - read.dcf(config_file, all = TRUE), - warning = malformed, - error = malformed - ) - } else { - config <- NULL - } + config <- read_config_file(config_file) for (setting in names(default_settings)) { value <- get_setting(setting, config, default_settings) @@ -49,21 +48,39 @@ read_settings <- function(filename) { } } -get_setting <- function(setting, config, defaults) { - option <- getOption(paste(sep = ".", "lintr", setting)) - if (!is.null(option)) { - option - } else if (!is.null(config[[setting]])) { +read_config_file <- function(config_file) { + if (is.null(config_file)) { + return(NULL) + } + + config <- new.env() + if (endsWith(config_file, ".R")) { + load_config <- function(file) sys_source(file, config) malformed <- function(e) { - stop("Malformed config setting '", setting, "'\n ", conditionMessage(e), call. = FALSE) + stop("Malformed config file, ensure it is valid R syntax\n ", conditionMessage(e), call. = FALSE) } - tryCatch( - eval(parse(text = config[[setting]])), - error = malformed - ) } else { - defaults[[setting]] + load_config <- function(file) { + dcf_values <- read.dcf(file, all = TRUE) + for (setting in names(dcf_values)) { + tryCatch( + assign(setting, eval(str2lang(dcf_values[[setting]])), envir = config), + error = function(e) stop("Malformed config setting '", setting, "'\n ", conditionMessage(e), call. = FALSE) + ) + } + } + malformed <- function(e) { + stop("Malformed config file, ensure it ends in a newline\n ", conditionMessage(e), call. = FALSE) + } } + tryCatch(load_config(config_file), warning = malformed, error = malformed) + config +} + +lintr_option <- function(setting, default = NULL) getOption(paste0("lintr.", setting), default) + +get_setting <- function(setting, config, defaults) { + lintr_option(setting) %||% config[[setting]] %||% defaults[[setting]] } reset_settings <- function() list2env(default_settings, envir = settings) diff --git a/R/settings_utils.R b/R/settings_utils.R index 3ca34d415..544de7d85 100644 --- a/R/settings_utils.R +++ b/R/settings_utils.R @@ -55,7 +55,7 @@ find_config <- function(filename) { if (is.null(filename)) { return(NULL) } - linter_file <- getOption("lintr.linter_file") + linter_file <- lintr_option("linter_file") ## if users changed lintr.linter_file, return immediately. if (is_absolute_path(linter_file) && file.exists(linter_file)) { @@ -87,10 +87,12 @@ find_config <- function(filename) { } find_local_config <- function(path, config_file) { + # R config gets precedence + configs_to_check <- c(paste0(config_file, ".R"), config_file) repeat { guesses_in_dir <- c( - file.path(path, config_file), - file.path(path, ".github", "linters", config_file) + file.path(path, configs_to_check), + file.path(path, ".github", "linters", configs_to_check) ) found <- first_exists(guesses_in_dir) if (!is.null(found)) { diff --git a/R/use_lintr.R b/R/use_lintr.R index 2a40311c4..235946c6b 100644 --- a/R/use_lintr.R +++ b/R/use_lintr.R @@ -25,7 +25,7 @@ #' lintr::lint_dir() #' } use_lintr <- function(path = ".", type = c("tidyverse", "full")) { - config_file <- normalizePath(file.path(path, getOption("lintr.linter_file")), mustWork = FALSE) + config_file <- normalizePath(file.path(path, lintr_option("linter_file")), mustWork = FALSE) if (file.exists(config_file)) { stop("Found an existing configuration file at '", config_file, "'.") } diff --git a/R/utils.R b/R/utils.R index b148050b2..e9718dfb7 100644 --- a/R/utils.R +++ b/R/utils.R @@ -1,5 +1,5 @@ `%||%` <- function(x, y) { - if (is.null(x) || length(x) <= 0L || is.na(x[[1L]])) { + if (is.null(x) || length(x) == 0L || (is.atomic(x[[1L]]) && is.na(x[[1L]]))) { y } else { x diff --git a/R/zzz.R b/R/zzz.R index 307d20589..f7ed629e1 100644 --- a/R/zzz.R +++ b/R/zzz.R @@ -277,6 +277,18 @@ default_undesirable_operators <- all_undesirable_operators[names(all_undesirable #' @export default_settings <- NULL +# TODO(R>=3.6.0): Just use sys.source() directly. Note that we can't +# write a wrapper that only passes keep.parse.data=FALSE on R>3.5.0 +# (without doing some wizardry to evade R CMD check) because +# there is a check for arguments not matching the signature which +# will throw a false positive on R3.5.0. Luckily the argument +# defaults on R>=3.6.0 are dictated by global options, so we can use +# that for the wrapper here rather than doing some NSE tricks. +sys_source <- function(...) { + old <- options(keep.source.pkgs = FALSE, keep.parse.data.pkgs = FALSE) + on.exit(options(old)) + sys.source(...) +} settings <- new.env(parent = emptyenv()) # nocov start @@ -288,8 +300,10 @@ settings <- new.env(parent = emptyenv()) toset <- !(names(op_lintr) %in% names(op)) if (any(toset)) options(op_lintr[toset]) - backports::import(pkgname, c("trimws", "lengths", "deparse1", "...names")) - # requires R>=3.6.0; see https://github.com/r-lib/backports/issues/68 + # R>=3.6.0: str2expression, str2lang + # R>=4.0.0: deparse1 + # R>=4.1.0: ...names + backports::import(pkgname, c("deparse1", "...names")) base_ns <- getNamespace("base") backports_ns <- getNamespace("backports") lintr_ns <- getNamespace(pkgname) diff --git a/man/read_settings.Rd b/man/read_settings.Rd index 5b4234ecc..c6e3f1c2f 100644 --- a/man/read_settings.Rd +++ b/man/read_settings.Rd @@ -22,5 +22,14 @@ Lintr searches for settings for a given source file in the following order: \details{ The default linter_file name is \code{.lintr} but it can be changed with option \code{lintr.linter_file} or the environment variable \code{R_LINTR_LINTER_FILE} -This file is a dcf file, see \code{\link[base:dcf]{base::read.dcf()}} for details. +This file is a DCF file, see \code{\link[base:dcf]{base::read.dcf()}} for details. +Experimentally, we also support keeping the config in a plain R file. By default we look for +a file named '.lintr.R' (in the same directories where we search for '.lintr'). +We are still deciding the future of config support in lintr, so user feedback is welcome. +The advantage of R is that it maps more closely to how the configs are actually stored, +whereas the DCF approach requires somewhat awkward formatting of parseable R code within +valid DCF key-value pairs. The main disadvantage of the R file is it might be \emph{too} flexible, +with users tempted to write configs with side effects causing hard-to-detect bugs or +like YAML could work, but require new dependencies and are harder to parse +both programmatically and visually. } diff --git a/tests/testthat/dummy_packages/RConfig/DESCRIPTION b/tests/testthat/dummy_packages/RConfig/DESCRIPTION new file mode 100644 index 000000000..f10c3169f --- /dev/null +++ b/tests/testthat/dummy_packages/RConfig/DESCRIPTION @@ -0,0 +1,3 @@ +Package: RConfig +Version: 0.0.1 + diff --git a/tests/testthat/dummy_packages/RConfig/R/lint_me.R b/tests/testthat/dummy_packages/RConfig/R/lint_me.R new file mode 100644 index 000000000..057802185 --- /dev/null +++ b/tests/testthat/dummy_packages/RConfig/R/lint_me.R @@ -0,0 +1,8 @@ +# config excludes assignment_linter() so this doesn't lint +a = 1 +# default config includes infix_spaces_linter() so this lints +b=a + 2 +# config extends defaults with any_duplicated_linter() so this lints +any(duplicated(b)) +# custom exclude setting is also picked up so this doesn't lint +1+1 # NOLINT diff --git a/tests/testthat/dummy_packages/RConfig/lintr_test_config.R b/tests/testthat/dummy_packages/RConfig/lintr_test_config.R new file mode 100644 index 000000000..1d9306d6a --- /dev/null +++ b/tests/testthat/dummy_packages/RConfig/lintr_test_config.R @@ -0,0 +1,6 @@ +linters <- linters_with_defaults( + any_duplicated_linter(), + assignment_linter = NULL +) +exclude <- "# NOLINT" +exclusions <- list("tests/testthat.R") diff --git a/tests/testthat/dummy_packages/RConfig/lintr_test_config_conflict b/tests/testthat/dummy_packages/RConfig/lintr_test_config_conflict new file mode 100644 index 000000000..f949e67e3 --- /dev/null +++ b/tests/testthat/dummy_packages/RConfig/lintr_test_config_conflict @@ -0,0 +1,6 @@ +linters: linters_with_defaults( + any_duplicated_linter(), + assignment_linter = NULL + ) +exclude: "# NOLINT" +exclusions: list("tests/testthat.R") diff --git a/tests/testthat/dummy_packages/RConfig/lintr_test_config_conflict.R b/tests/testthat/dummy_packages/RConfig/lintr_test_config_conflict.R new file mode 100644 index 000000000..0b6169ddf --- /dev/null +++ b/tests/testthat/dummy_packages/RConfig/lintr_test_config_conflict.R @@ -0,0 +1,6 @@ +linters <- linters_with_defaults( + expect_null_linter(), + assignment_linter = NULL +) +exclude <- "# SKIP_LINT" +exclusions <- list("R/lint_me.R") diff --git a/tests/testthat/dummy_packages/RConfig/lintr_test_config_extraneous.R b/tests/testthat/dummy_packages/RConfig/lintr_test_config_extraneous.R new file mode 100644 index 000000000..5cfe44080 --- /dev/null +++ b/tests/testthat/dummy_packages/RConfig/lintr_test_config_extraneous.R @@ -0,0 +1,12 @@ +# here are some extraneous variables that are not part of the config directly + +non_default_linter <- any_duplicated_linter() +attr(non_default_linter, "name") <- "any_duplicated_linter" +excluded_files <- "tests/testthat.R" + +linters <- linters_with_defaults( + non_default_linter, + assignment_linter = NULL +) +exclude <- "# NOLINT" +exclusions <- list(excluded_files) diff --git a/tests/testthat/dummy_packages/RConfig/tests/testthat.R b/tests/testthat/dummy_packages/RConfig/tests/testthat.R new file mode 100644 index 000000000..7eec1f527 --- /dev/null +++ b/tests/testthat/dummy_packages/RConfig/tests/testthat.R @@ -0,0 +1,8 @@ +# This file is in 'exclusions' & nothing lints under R config. +# Under DCF config, '# SKIP_LINT' is the exclusion & this line won't lint +1+1 # SKIP_LINT +# This is included as a linter in the DCF, thus this should lint +expect_equal(foo(x), NULL) + +# trailing blank line next will lint under DCF + diff --git a/tests/testthat/dummy_packages/RConfigInvalid/DESCRIPTION b/tests/testthat/dummy_packages/RConfigInvalid/DESCRIPTION new file mode 100644 index 000000000..5b36205d8 --- /dev/null +++ b/tests/testthat/dummy_packages/RConfigInvalid/DESCRIPTION @@ -0,0 +1,3 @@ +Package: RConfigInvalid +Version: 0.0.1 + diff --git a/tests/testthat/dummy_packages/RConfigInvalid/R/lint_me.R b/tests/testthat/dummy_packages/RConfigInvalid/R/lint_me.R new file mode 100644 index 000000000..6bedc9eef --- /dev/null +++ b/tests/testthat/dummy_packages/RConfigInvalid/R/lint_me.R @@ -0,0 +1 @@ +a <- 1 diff --git a/tests/testthat/dummy_packages/RConfigInvalid/lintr_test_config.R b/tests/testthat/dummy_packages/RConfigInvalid/lintr_test_config.R new file mode 100644 index 000000000..1853e47b2 --- /dev/null +++ b/tests/testthat/dummy_packages/RConfigInvalid/lintr_test_config.R @@ -0,0 +1,2 @@ +# invalid R syntax +1 + diff --git a/tests/testthat/test-lint_package.R b/tests/testthat/test-lint_package.R index 4a275b2a5..598f2a9ff 100644 --- a/tests/testthat/test-lint_package.R +++ b/tests/testthat/test-lint_package.R @@ -198,3 +198,50 @@ test_that( expect_length(subdir_lints, 0L) } ) + +test_that("package using .lintr.R config lints correctly", { + withr::local_options(lintr.linter_file = "lintr_test_config") + + r_config_pkg <- test_path("dummy_packages", "RConfig") + + lints <- as.data.frame(lint_package(r_config_pkg)) + expect_identical(unique(basename(lints$filename)), "lint_me.R") + expect_identical(lints$linter, c("infix_spaces_linter", "any_duplicated_linter")) + + # config has bad R syntax + expect_error( + lint_package(test_path("dummy_packages", "RConfigInvalid")), + "Malformed config file, ensure it is valid R syntax", + fixed = TRUE + ) + + # config produces unused variables + withr::local_options(lintr.linter_file = "lintr_test_config_extraneous") + expect_length(lint_package(r_config_pkg), 2L) + + # DCF is preferred if multiple matched configs + withr::local_options(lintr.linter_file = "lintr_test_config_conflict") + lints <- as.data.frame(lint_package(r_config_pkg)) + expect_identical(unique(basename(lints$filename)), "testthat.R") + expect_identical(lints$linter, c("expect_null_linter", "trailing_blank_lines_linter")) +}) + +test_that("lintr need not be attached for .lintr.R configs to use lintr functions", { + skip_if_not_r_version("3.6.0") # unclear error message + exprs <- paste( + 'options(lintr.linter_file = "lintr_test_config")', + sprintf('lints <- lintr::lint_package("%s")', test_path("dummy_packages", "RConfig")), + # simplify output to be read from stdout + 'cat(paste(as.data.frame(lints)$linter, collapse = "|"), "\n", sep = "")', + sep = "; " + ) + if (tolower(Sys.info()[["sysname"]]) == "windows") { + rscript <- file.path(R.home("bin"), "Rscript.exe") + } else { + rscript <- file.path(R.home("bin"), "Rscript") + } + expect_identical( + system2(rscript, c("-e", shQuote(exprs)), stdout = TRUE), + "infix_spaces_linter|any_duplicated_linter" + ) +})