Update the set of linters

.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(

R/0_linters.R

@@ -8,12 +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(),
-    "documentation_template_linter" = documentation_template_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)
@@ -89,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
@@ -106,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) {
@@ -122,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))
         )
@@ -316,7 +336,7 @@ param_and_field_linter <- function() {
 #' @importFrom rlang .data
 #' @noRd
 documentation_template_linter <- function() {
-  general_msg <- paste("Documentation templates should used if available!")
+  general_msg <- paste("Documentation templates should used if available.")
 
   lintr::Linter(
     function(source_expression) {

R/test_diseasystore.R

@@ -325,9 +325,9 @@ test_diseasystore <- function(
           dplyr::collect() |>
           dplyr::filter(.data$valid_until <= !!test_start_date | !!test_end_date < .data$valid_from)
 
-        testthat::expect_equal(
+        testthat::expect_identical(
           SCDB::nrow(reference_out_of_bounds),
-          0,
+          0L,
           info = glue::glue("Feature `{.x}` returns data outside the study period.")
         )
 
@@ -338,29 +338,29 @@ test_diseasystore <- function(
           dplyr::collect() |>
           purrr::map(~ DBI::dbDataType(dbObj = conn, obj = .))
 
-        testthat::expect_equal(
+        testthat::expect_identical(
           purrr::pluck(validity_period_data_types, "valid_from"),
           DBI::dbDataType(dbObj = conn, obj = as.Date(0)),
           info = glue::glue("Feature `{.x}` has a non-Date `valid_from` column.")
         )
-        testthat::expect_equal(
+        testthat::expect_identical(
           purrr::pluck(validity_period_data_types, "valid_until"),
           DBI::dbDataType(dbObj = conn, obj = as.Date(0)),
           info = glue::glue("Feature `{.x}` has a non-Date `valid_until` column.")
         )
 
         # Check that valid_until (date or NA) is (strictly) greater than valid_from (date)
         # Remember that data is valid in the interval [valid_from, valid_until) and NA is treated as infinite
-        testthat::expect_equal(
+        testthat::expect_identical(
           SCDB::nrow(dplyr::filter(reference, is.na(.data$valid_from))),
-          0
+          0L
         )
 
-        testthat::expect_equal(
+        testthat::expect_identical(
           reference |>
             dplyr::filter(.data$valid_from >= .data$valid_until) |>
             SCDB::nrow(),
-          0,
+          0L,
           info = glue::glue("Feature `{.x}` has some elements where `valid_from` >= `valid_until`.")
         )
 
@@ -459,8 +459,8 @@ test_diseasystore <- function(
   # Helper function that checks the output of key_joins
   key_join_features_tester <- function(output, start_date, end_date) {
     # The output dates should match start and end date
-    testthat::expect_equal(min(output$date), start_date)
-    testthat::expect_equal(max(output$date), end_date)
+    testthat::expect_identical(min(output$date), start_date)
+    testthat::expect_identical(max(output$date), end_date)
   }
 
 

pak.lock

@@ -2495,7 +2495,7 @@
     {
       "ref": "openssl",
       "package": "openssl",
-      "version": "2.3.0",
+      "version": "2.3.1",
       "type": "standard",
       "direct": false,
       "binary": true,
@@ -2507,10 +2507,10 @@
         "RemoteRef": "openssl",
         "RemoteRepos": "https://packagemanager.posit.co/cran/__linux__/noble/latest",
         "RemotePkgPlatform": "x86_64-pc-linux-gnu-ubuntu-24.04",
-        "RemoteSha": "2.3.0"
+        "RemoteSha": "2.3.1"
       },
-      "sources": "https://packagemanager.posit.co/cran/__linux__/noble/latest/src/contrib/openssl_2.3.0.tar.gz",
-      "target": "src/contrib/x86_64-pc-linux-gnu-ubuntu-24.04/4.4/openssl_2.3.0.tar.gz",
+      "sources": "https://packagemanager.posit.co/cran/__linux__/noble/latest/src/contrib/openssl_2.3.1.tar.gz",
+      "target": "src/contrib/x86_64-pc-linux-gnu-ubuntu-24.04/4.4/openssl_2.3.1.tar.gz",
       "platform": "x86_64-pc-linux-gnu-ubuntu-24.04",
       "rversion": "4.4",
       "directpkg": false,

tests/testthat/test-0_linters.R

@@ -61,9 +61,10 @@ test_that("param_and_field_linter works", {
 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 (`character(1)`)\\cr", # rd_observable defined in R/0_documentation.R                         # nolint: documentation_template_linter
+    "#' @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()
   )

tests/testthat/test-DiseasystoreBase.R

@@ -146,7 +146,7 @@ test_that("$get_feature verbosity works", {
       type = "message"
     )
     messages <- purrr::discard(messages, ~ !startsWith(., "feature:"))
-    expect_equal(messages, character(0))
+    expect_identical(messages, character(0))
 
     rm(ds)
     DBI::dbDisconnect(conn)

tests/testthat/test-age_helpers.R

@@ -69,7 +69,7 @@ test_that("age_on_date() works for date input", {
 
     }
 
-    expect_equal(
+    expect_equal(                                                                                                       # nolint: expect_identical_linter. The return data types from the different database backends may not always be identical
       dplyr::pull(test_ages,      "age"),
       dplyr::pull(reference_ages, "age")
     )
@@ -118,7 +118,7 @@ test_that("age_on_date() works for reference input", {
 
     }
 
-    expect_equal(
+    expect_equal(                                                                                                       # nolint: expect_identical_linter. The return data types from the different database backends may not always be identical
       dplyr::pull(test_ages,      "age"),
       dplyr::pull(reference_ages, "age")
     )
@@ -191,7 +191,7 @@ test_that("add_years() works for positive input", {
 
     }
 
-    expect_equal(
+    expect_identical(
       dplyr::pull(test_ages,      "first_birthday"),
       dplyr::pull(reference_ages, "first_birthday")
     )
@@ -252,7 +252,7 @@ test_that("add_years() works for negative input", {
 
     }
 
-    expect_equal(
+    expect_identical(
       dplyr::pull(test_ages,      "test_date"),
       dplyr::pull(reference_ages, "test_date")
     )
@@ -314,7 +314,7 @@ test_that("add_years() works for reference input", {
 
     }
 
-    expect_equal(
+    expect_identical(
       dplyr::pull(test_ages,      "first_birthday"),
       dplyr::pull(reference_ages, "first_birthday")
     )
@@ -381,7 +381,7 @@ test_that("add_years() works for date input", {
 
     }
 
-    expect_equal(
+    expect_identical(
       dplyr::pull(test_ages,      "future_date"),
       dplyr::pull(reference_ages, "future_date")
     )

tests/testthat/test-truncate_interlace.R

@@ -97,8 +97,8 @@ test_that("truncate_interlace works", {
       max_date_secondary <- purrr::reduce(purrr::map(secondary, ~ max(.x$valid_until)), max)
       max_date <- min(max_date_secondary, max(primary$valid_until))
 
-      expect_equal(min(output$valid_from),  min_date)
-      expect_equal(max(output$valid_until), max_date)
+      expect_equal(min(output$valid_from),  min_date)                                                                   # nolint: expect_identical_linter. The return data types from the different database backends may not always be identical
+      expect_equal(max(output$valid_until), max_date)                                                                   # nolint: expect_identical_linter. The return data types from the different database backends may not always be identical
 
     }