chore: synced file(s) with ssi-dk/AEF-DDF

ssi-dk · Jan 9, 2025 · 3dc6938 · 3dc6938
1 parent 2a6d782
commit 3dc6938
Show file tree

Hide file tree

Showing 3 changed files with 135 additions and 27 deletions.
diff --git 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
@@ -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
@@ -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()
+  )
+})