Skip to content

Commit b157073

Browse files
RasmusSkytteRasmusSkytte
committed
chore: synced file(s) with ssi-dk/AEF-DDF
1 parent 7c0654c commit b157073

File tree

4 files changed

+83
-62
lines changed

4 files changed

+83
-62
lines changed

‎.lintr

+2-16
Original file line numberDiff line numberDiff line change
@@ -1,21 +1,7 @@
1-
linters: c(
2-
diseasy_code_linters(),
3-
all_linters(
4-
line_length_linter = NULL, # We use 120, nolint-aware line length linter instead
5-
cyclocomp_linter = NULL, # Not required in diseasy style guide
6-
keyword_quote_linter = NULL, # Not required in diseasy style guide
7-
implicit_integer_linter = NULL, # Not required in diseasy style guide
8-
extraction_operator_linter = NULL, # Fails for .data$*
9-
nonportable_path_linter = NULL, # Any \\ is flagged. Therefore fails when escaping backslashes
10-
undesirable_function_linter = NULL, # Library calls in vignettes are flagged and any call to options
11-
unnecessary_lambda_linter = NULL, # Fails for purrr::map with additional function arguments
12-
strings_as_factors_linter = NULL, # Seems to be some backwards compatibility stuff.
13-
expect_identical_linter = NULL # Seems a little aggressive to require this.
14-
)
15-
)
1+
linters: diseasy_code_linters()
162
exclude_linter: paste0(
173
"^ *: *(", # Any number of spaces before and after the colon
18-
paste(c(names(lintr::all_linters()), names(diseasy_code_linters())), collapse = "|"), # Any of our linters
4+
paste(names(diseasy_code_linters()), collapse = "|"), # Any of our linters
195
",| )+(\\.|$)" # As a comma separated list (with optional spaces) followed by a period or end of line
206
)
217
exclusions: c(

‎R/0_linters.R

+33-13
Original file line numberDiff line numberDiff line change
@@ -8,12 +8,25 @@
88
#' @return A list of linters
99
#' @noRd
1010
diseasy_code_linters <- function() {
11-
linters <- list(
12-
"nolint_position_linter" = nolint_position_linter(120),
13-
"nolint_line_length_linter" = nolint_line_length_linter(120),
14-
"non_ascii_linter" = non_ascii_linter(),
15-
"param_and_field_linter" = param_and_field_linter(),
16-
"documentation_template_linter" = documentation_template_linter()
11+
linters <- c(
12+
list(
13+
"nolint_position_linter" = nolint_position_linter(length = 120L),
14+
"nolint_line_length_linter" = nolint_line_length_linter(length = 120L),
15+
"non_ascii_linter" = non_ascii_linter(),
16+
"param_and_field_linter" = param_and_field_linter(),
17+
"documentation_template_linter" = documentation_template_linter()
18+
),
19+
lintr::all_linters(
20+
line_length_linter = NULL, # We use 120, nolint-aware line length linter instead
21+
cyclocomp_linter = NULL, # Not required in diseasy style guide
22+
keyword_quote_linter = NULL, # Not required in diseasy style guide
23+
implicit_integer_linter = NULL, # Not required in diseasy style guide
24+
extraction_operator_linter = NULL, # Fails for .data$*
25+
nonportable_path_linter = NULL, # Any \\ is flagged. Therefore fails when escaping backslashes
26+
undesirable_function_linter = NULL, # Library calls in vignettes are flagged and any call to options
27+
unnecessary_lambda_linter = NULL, # Fails for purrr::map with additional function arguments
28+
strings_as_factors_linter = NULL # Seems to be some backwards compatibility stuff.
29+
)
1730
)
1831

1932
return(linters)
@@ -89,7 +102,9 @@ nolint_position_linter <- function(length = 80L) {
89102
#' nolint_line_length_linter: Ensure lines adhere to a given character limit, ignoring `nolint` statements
90103
#'
91104
#' @param length (`numeric`)\cr
92-
#' Maximum line length allowed. Default is 80L (Hollerith limit)..
105+
#' Maximum line length allowed.
106+
#' @param code_block_length (`numeric`)\cr
107+
#' Maximum line length allowed for code blocks.
93108
#' @examples
94109
#' ## nolint_line_length_linter
95110
#' # will produce lints
@@ -106,8 +121,9 @@ nolint_position_linter <- function(length = 80L) {
106121
#'
107122
#' @importFrom rlang .data
108123
#' @noRd
109-
nolint_line_length_linter <- function(length = 80L) {
124+
nolint_line_length_linter <- function(length = 80L, code_block_length = 85L) {
110125
general_msg <- paste("Lines should not be more than", length, "characters.")
126+
code_block_msg <- paste("Code blocks should not be more than", code_block_length, "characters.")
111127

112128
lintr::Linter(
113129
function(source_expression) {
@@ -117,19 +133,23 @@ nolint_line_length_linter <- function(length = 80L) {
117133
return(list())
118134
}
119135

120-
nolint_regex <- r"{# ?no(lint|cov) ?(start|end)?:?.*}"
136+
nolint_regex <- r"{\s*# ?no(lint|cov) ?(start|end)?:?.*}"
121137

122138
file_lines_nolint_excluded <- source_expression$file_lines |>
123139
purrr::map_chr(\(s) stringr::str_remove(s, nolint_regex))
124140

141+
# Switch mode based on extension
142+
# .Rmd uses code_block_length
143+
code_block <- endsWith(tolower(source_expression$filename), ".rmd")
144+
125145
line_lengths <- nchar(file_lines_nolint_excluded)
126-
long_lines <- which(line_lengths > length)
146+
long_lines <- which(line_lengths > ifelse(code_block, code_block_length, length))
127147
Map(function(long_line, line_length) {
128148
lintr::Lint(
129149
filename = source_expression$filename,
130150
line_number = long_line,
131-
column_number = length + 1L, type = "style",
132-
message = paste(general_msg, "This line is", line_length, "characters."),
151+
column_number = ifelse(code_block, code_block_length, length) + 1L, type = "style",
152+
message = paste(ifelse(code_block, code_block_msg, general_msg), "This line is", line_length, "characters."),
133153
line = source_expression$file_lines[long_line],
134154
ranges = list(c(1L, line_length))
135155
)
@@ -316,7 +336,7 @@ param_and_field_linter <- function() {
316336
#' @importFrom rlang .data
317337
#' @noRd
318338
documentation_template_linter <- function() {
319-
general_msg <- paste("Documentation templates should used if available!")
339+
general_msg <- paste("Documentation templates should used if available.")
320340

321341
lintr::Linter(
322342
function(source_expression) {

‎tests/testthat/helper-setup.R

+46-32
Original file line numberDiff line numberDiff line change
@@ -36,17 +36,17 @@ get_test_conns <- function(skip_backends = NULL) {
3636
} else {
3737

3838
# Use the connection configured by the remote
39-
conn_list <- tibble::lst(!!Sys.getenv("BACKEND") := !!Sys.getenv("BACKEND_DRV")) # nolint: object_name_linter
39+
conn_list <- tibble::lst(!!Sys.getenv("BACKEND") := !!Sys.getenv("BACKEND_DRV"))
4040

4141
# Use the connection configured by the remote
42-
conn_args <- tibble::lst(!!Sys.getenv("BACKEND") := Sys.getenv("BACKEND_ARGS")) |> # nolint: object_name_linter
43-
purrr::discard(~ identical(., "")) |>
44-
purrr::map(~ eval(parse(text = .)))
42+
conn_args <- tibble::lst(!!Sys.getenv("BACKEND") := Sys.getenv("BACKEND_ARGS"))
43+
conn_args <- purrr::discard(conn_args, ~ identical(., ""))
44+
conn_args <- purrr::map(conn_args, ~ eval(parse(text = .)))
4545

4646
# Use the connection configured by the remote
47-
conn_post_connect <- tibble::lst(!!Sys.getenv("BACKEND") := Sys.getenv("BACKEND_POST_CONNECT")) |> # nolint: object_name_linter
48-
purrr::discard(~ identical(., "")) |>
49-
purrr::map(~ eval(parse(text = .)))
47+
conn_post_connect <- tibble::lst(!!Sys.getenv("BACKEND") := Sys.getenv("BACKEND_POST_CONNECT"))
48+
conn_post_connect <- purrr::discard(conn_post_connect, ~ identical(., ""))
49+
conn_post_connect <- purrr::map(conn_post_connect, ~ eval(parse(text = .)))
5050

5151
}
5252

@@ -60,9 +60,8 @@ get_test_conns <- function(skip_backends = NULL) {
6060

6161
# Combine all arguments
6262
backends <- unique(c(names(conn_list), names(conn_args), names(conn_args_json)))
63-
conn_args <- backends |>
64-
purrr::map(~ c(purrr::pluck(conn_args, .), purrr::pluck(conn_args_json, .))) |>
65-
stats::setNames(backends)
63+
conn_args <- purrr::map(backends, ~ c(purrr::pluck(conn_args, .), purrr::pluck(conn_args_json, .)))
64+
names(conn_args) <- backends
6665

6766

6867
get_driver <- function(x = character(), ...) { # nolint: object_usage_linter
@@ -83,28 +82,43 @@ get_test_conns <- function(skip_backends = NULL) {
8382
checkmate::assert_subset(names(conn_args), names(conn_list))
8483

8584
# Open connections
86-
drivers <- names(conn_list) |>
87-
purrr::map(~ do.call(get_driver, list(x = purrr::pluck(conn_list, .)))) |>
88-
stats::setNames(names(conn_list)) |>
89-
purrr::discard(is.null)
85+
drivers <- purrr::map(names(conn_list), ~ do.call(get_driver, list(x = purrr::pluck(conn_list, .))))
86+
names(drivers) <- names(conn_list)
87+
drivers <- purrr::discard(drivers, is.null)
9088

91-
test_conns <- names(drivers) |>
92-
purrr::map(~ do.call(SCDB::get_connection, c(list(drv = purrr::pluck(drivers, .)), purrr::pluck(conn_args, .)))) |>
93-
stats::setNames(names(drivers)) |>
94-
purrr::discard(is.null)
89+
test_conn_args <- purrr::map(
90+
names(drivers),
91+
~ c(list("drv" = purrr::pluck(drivers, .)), purrr::pluck(conn_args, .))
92+
)
93+
94+
test_conns <- purrr::map(
95+
test_conn_args,
96+
~ do.call(SCDB::get_connection, args = .)
97+
)
98+
names(test_conns) <- names(drivers)
99+
test_conns <- purrr::discard(test_conns, is.null)
95100

96101
# Skip backends if given
97-
test_conns <- test_conns |>
98-
purrr::walk(\(conn) {
99-
if (checkmate::test_multi_class(conn, purrr::pluck(skip_backends, .default = ""))) {
100-
DBI::dbDisconnect(conn)
102+
test_conns <- purrr::walk(
103+
test_conns,
104+
~ {
105+
if (checkmate::test_multi_class(., purrr::pluck(skip_backends, .default = ""))) {
106+
DBI::dbDisconnect(.)
101107
}
102-
}) |>
103-
purrr::discard(\(conn) checkmate::test_multi_class(conn, purrr::pluck(skip_backends, .default = "")))
108+
}
109+
)
110+
test_conns <- purrr::discard(
111+
test_conns,
112+
~ checkmate::test_multi_class(., purrr::pluck(skip_backends, .default = ""))
113+
)
104114

105115
# Run post_connect commands on the connections
106-
purrr::walk2(test_conns, names(test_conns),
107-
\(conn, conn_name) purrr::walk(purrr::pluck(conn_post_connect, conn_name), ~ DBI::dbExecute(conn, .)))
116+
purrr::iwalk(
117+
test_conns,
118+
function(conn, conn_name) {
119+
purrr::walk(purrr::pluck(conn_post_connect, conn_name), ~ DBI::dbExecute(conn, .))
120+
}
121+
)
108122

109123
# Inform the user about the tested back ends:
110124
msg <- paste(sep = "\n",
@@ -141,12 +155,12 @@ get_test_conns <- function(skip_backends = NULL) {
141155
checkmate_err_msg <- function(expr) {
142156
tryCatch(
143157
expr,
144-
error = \(e) {
145-
e$message |>
146-
stringr::str_remove_all(stringr::fixed("\n *")) |>
147-
stringr::str_remove_all(stringr::fixed("* ")) |>
148-
simpleError(message = _) |>
149-
stop()
158+
error = function(e) {
159+
msg <- e$message
160+
msg <- stringr::str_remove_all(msg, stringr::fixed("\n *"))
161+
msg <- stringr::str_remove_all(msg, stringr::fixed("* "))
162+
163+
stop(simpleError(message = msg))
150164
}
151165
)
152166
}

‎tests/testthat/test-0_linters.R

+2-1
Original file line numberDiff line numberDiff line change
@@ -61,9 +61,10 @@ test_that("param_and_field_linter works", {
6161
test_that("documentation_template_linter works", {
6262
skip_if_not_installed("lintr")
6363
skip_if_not_installed("devtools")
64+
skip_if(!identical(Sys.getenv("R_CHECK"), "true"), "Skip if running in R_check")
6465

6566
lintr::expect_lint(
66-
"#' @param observable (`character(1)`)\\cr", # rd_observable defined in R/0_documentation.R # nolint: documentation_template_linter
67+
"#' @param observable text", # rd_observable defined in R/0_documentation.R # nolint: documentation_template_linter, param_and_field_linter
6768
list("line_number" = 1, "type" = "style"),
6869
documentation_template_linter()
6970
)

0 commit comments

Comments
 (0)