diff --git a/.lintr b/.lintr index c5d6f6d5..1e2fa28e 100644 --- a/.lintr +++ b/.lintr @@ -1,21 +1,7 @@ -linters: c( - diseasy_code_linters(), - all_linters( - line_length_linter = NULL, # We use 120, nolint-aware line length linter instead - cyclocomp_linter = NULL, # Not required in diseasy style guide - keyword_quote_linter = NULL, # Not required in diseasy style guide - implicit_integer_linter = NULL, # Not required in diseasy style guide - extraction_operator_linter = NULL, # Fails for .data$* - nonportable_path_linter = NULL, # Any \\ is flagged. Therefore fails when escaping backslashes - undesirable_function_linter = NULL, # Library calls in vignettes are flagged and any call to options - unnecessary_lambda_linter = NULL, # Fails for purrr::map with additional function arguments - strings_as_factors_linter = NULL, # Seems to be some backwards compatibility stuff. - expect_identical_linter = NULL # Seems a little aggressive to require this. - ) - ) +linters: diseasy_code_linters() exclude_linter: paste0( "^ *: *(", # Any number of spaces before and after the colon - paste(c(names(lintr::all_linters()), names(diseasy_code_linters())), collapse = "|"), # Any of our linters + paste(names(diseasy_code_linters()), collapse = "|"), # Any of our linters ",| )+(\\.|$)" # As a comma separated list (with optional spaces) followed by a period or end of line ) exclusions: c( diff --git a/R/0_linters.R b/R/0_linters.R index 3f699da0..1b1aaf5b 100644 --- a/R/0_linters.R +++ b/R/0_linters.R @@ -8,11 +8,25 @@ #' @return A list of linters #' @noRd diseasy_code_linters <- function() { - linters <- list( - "nolint_position_linter" = nolint_position_linter(120), - "nolint_line_length_linter" = nolint_line_length_linter(120), - "non_ascii_linter" = non_ascii_linter(), - "param_and_field_linter" = param_and_field_linter() + linters <- c( + list( + "nolint_position_linter" = nolint_position_linter(length = 120L), + "nolint_line_length_linter" = nolint_line_length_linter(length = 120L), + "non_ascii_linter" = non_ascii_linter(), + "param_and_field_linter" = param_and_field_linter(), + "documentation_template_linter" = documentation_template_linter() + ), + lintr::all_linters( + line_length_linter = NULL, # We use 120, nolint-aware line length linter instead + cyclocomp_linter = NULL, # Not required in diseasy style guide + keyword_quote_linter = NULL, # Not required in diseasy style guide + implicit_integer_linter = NULL, # Not required in diseasy style guide + extraction_operator_linter = NULL, # Fails for .data$* + nonportable_path_linter = NULL, # Any \\ is flagged. Therefore fails when escaping backslashes + undesirable_function_linter = NULL, # Library calls in vignettes are flagged and any call to options + unnecessary_lambda_linter = NULL, # Fails for purrr::map with additional function arguments + strings_as_factors_linter = NULL # Seems to be some backwards compatibility stuff. + ) ) return(linters) @@ -88,7 +102,9 @@ nolint_position_linter <- function(length = 80L) { #' nolint_line_length_linter: Ensure lines adhere to a given character limit, ignoring `nolint` statements #' #' @param length (`numeric`)\cr -#' Maximum line length allowed. Default is 80L (Hollerith limit).. +#' Maximum line length allowed. +#' @param code_block_length (`numeric`)\cr +#' Maximum line length allowed for code blocks. #' @examples #' ## nolint_line_length_linter #' # will produce lints @@ -105,8 +121,9 @@ nolint_position_linter <- function(length = 80L) { #' #' @importFrom rlang .data #' @noRd -nolint_line_length_linter <- function(length = 80L) { +nolint_line_length_linter <- function(length = 80L, code_block_length = 85L) { general_msg <- paste("Lines should not be more than", length, "characters.") + code_block_msg <- paste("Code blocks should not be more than", code_block_length, "characters.") lintr::Linter( function(source_expression) { @@ -121,14 +138,18 @@ nolint_line_length_linter <- function(length = 80L) { file_lines_nolint_excluded <- source_expression$file_lines |> purrr::map_chr(\(s) stringr::str_remove(s, nolint_regex)) + # Switch mode based on extension + # .Rmd uses code_block_length + code_block <- endsWith(tolower(source_expression$filename), ".rmd") + line_lengths <- nchar(file_lines_nolint_excluded) - long_lines <- which(line_lengths > length) + long_lines <- which(line_lengths > ifelse(code_block, code_block_length, length)) Map(function(long_line, line_length) { lintr::Lint( filename = source_expression$filename, line_number = long_line, - column_number = length + 1L, type = "style", - message = paste(general_msg, "This line is", line_length, "characters."), + column_number = ifelse(code_block, code_block_length, length) + 1L, type = "style", + message = paste(ifelse(code_block, code_block_msg, general_msg), "This line is", line_length, "characters."), line = source_expression$file_lines[long_line], ranges = list(c(1L, line_length)) ) @@ -211,7 +232,7 @@ non_ascii_linter <- function() { #' #' # okay #' lintr::lint( -#' text = "#' @param (`numeric()`)\cr", +#' text = "#' @param test (`numeric()`)\cr", #' linters = param_and_field_linter() #' ) #' @importFrom rlang .data @@ -290,3 +311,85 @@ param_and_field_linter <- function() { } ) } + + +#' @rdname diseasy_linters +#' @description +#' documentation_template_linter: Ensure documentation templates are used if available. +#' +#' @examples +#' ## documentation_template_linter +#' rd_parameter <- "(`character`)\cr Description of parameter" # Create a template for the "parameter" parameter +#' +#' # will produce lints +#' lintr::lint( +#' text = "#' @param parameter (`character`)\cr Description of parameter", # nolint: documentation_template_linter +#' linters = documentation_template_linter() +#' ) +#' +#' # okay +#' lintr::lint( +#' text = "#' @param parameter `r rd_parameter`", +#' linters = documentation_template_linter() +#' ) +#' +#' @importFrom rlang .data +#' @noRd +documentation_template_linter <- function() { + general_msg <- paste("Documentation templates should used if available.") + + lintr::Linter( + function(source_expression) { + + # Only go over complete file + if (!lintr::is_lint_level(source_expression, "file")) { + return(list()) + } + + # Find all @param and @field lines. All other lines become NA + detection_info <- source_expression$file_lines |> + stringr::str_extract(r"{#' ?@(param|field).*}") + + # Convert to data.frame and determine line number + detection_info <- data.frame( + rd_line = detection_info, + line_number = seq_along(detection_info) + ) + + # Remove non param/field lines + detection_info <- detection_info |> + dplyr::filter(!is.na(.data$rd_line)) + + # Remove triple-dot-ellipsis params + detection_info <- detection_info |> + dplyr::filter(!stringr::str_detect(.data$rd_line, "@param +\\.{3}")) + + # Remove auto-generated documentation + detection_info <- detection_info |> + dplyr::filter(!stringr::str_detect(.data$rd_line, r"{@(param|field) +[\.\w]+ +`r }")) + + # Extract the parameter + detection_info <- detection_info |> + dplyr::mutate("param" = stringr::str_extract(.data$rd_line, r"{(@(param|field) +)([\.\w]+)}", group = 3)) + + # Detect if template exists + detection_info <- detection_info |> + dplyr::mutate("rd_template" = paste0("rd_", .data$param)) |> + dplyr::filter(.data$rd_template %in% names(as.list(base::getNamespace(devtools::as.package(".")$package)))) |> + dplyr::select(!"param") + + purrr::pmap( + detection_info, + \(rd_line, line_number, rd_template) { + lintr::Lint( + filename = source_expression$filename, + line_number = line_number, + type = "style", + message = paste(general_msg, "Template", rd_template, "available."), + line = source_expression$file_lines[line_number] + ) + } + ) + } + ) +} diff --git a/tests/testthat/test-0_linters.R b/tests/testthat/test-0_linters.R index 88c4b022..7c15822a 100644 --- a/tests/testthat/test-0_linters.R +++ b/tests/testthat/test-0_linters.R @@ -56,3 +56,22 @@ test_that("param_and_field_linter works", { lintr::expect_lint("#' @param test (`type`)\\cr", NULL, param_and_field_linter()) lintr::expect_lint("#' @field test (`type`)\\cr", NULL, param_and_field_linter()) }) + + +test_that("documentation_template_linter works", { + skip_if_not_installed("lintr") + skip_if_not_installed("devtools") + skip_if(!identical(Sys.getenv("R_CHECK"), "true"), "Skip if running in R_check") + + lintr::expect_lint( + "#' @param observable text", # rd_observable defined in R/0_documentation.R # nolint: documentation_template_linter, param_and_field_linter + list("line_number" = 1, "type" = "style"), + documentation_template_linter() + ) + + lintr::expect_lint( + "#' @param observable `r rd_test`", + NULL, + documentation_template_linter() + ) +})