Nothing
#' @export
format.lint <- function(x, ...) {
if (requireNamespace("crayon", quietly = TRUE)) {
color <- switch(x$type,
warning = crayon::magenta,
error = crayon::red,
style = crayon::blue,
crayon::bold
)
emph <- crayon::bold
} else {
# nocov start
color <- identity
emph <- identity
# nocov end
}
paste0(
emph(
x$filename, ":",
as.character(x$line_number), ":",
as.character(x$column_number), ": ",
sep = ""
),
color(x$type, ": ", sep = ""),
"[", x$linter, "] ",
emph(x$message), "\n",
# swap tabs for spaces for #528 (sorry Richard Hendricks)
chartr("\t", " ", x$line), "\n",
highlight_string(x$message, x$column_number, x$ranges),
"\n"
)
}
#' @export
print.lint <- function(x, ...) {
cat(format(x))
invisible(x)
}
markdown <- function(x, info, ...) {
cat(
sep = "",
"[", x$filename, ":",
as.character(x$line_number), ":",
as.character(x$column_number), ":", "]",
"(",
file.path(
"https://github.com",
info$user,
info$repo,
"blob",
info$commit,
x$filename
), "#L", x$line_number,
")",
" ",
"*", x$type, ":", "* ",
"[", x$linter, "] ",
"**", x$message, "**\n",
"```r\n\U200B", # we use a zero width unicode character here so that Github
# does not strip the leading whitespace
x$line, "\n",
highlight_string(x$message, x$column_number, x$ranges),
"\n```\n"
)
invisible(x)
}
#' @export
format.lints <- function(x, ...) {
paste(vapply(x, format, character(1L)), collapse = "\n")
}
#' @export
print.lints <- function(x, ...) {
use_rstudio_source_markers <- lintr_option("rstudio_source_markers", TRUE) &&
requireNamespace("rstudioapi", quietly = TRUE) &&
rstudioapi::hasFun("sourceMarkers")
github_annotation_project_dir <- lintr_option("github_annotation_project_dir", "")
if (length(x) > 0L) {
inline_data <- x[[1L]][["filename"]] == "<text>"
if (!inline_data && use_rstudio_source_markers) {
rstudio_source_markers(x)
} else if (in_github_actions()) {
github_actions_log_lints(x, project_dir = github_annotation_project_dir)
} else {
if (in_ci() && settings$comment_bot) {
info <- ci_build_info()
lint_output <- trim_output(
paste0(
collapse = "\n",
capture.output(invisible(lapply(x, markdown, info, ...)))
)
)
github_comment(lint_output, info, ...)
}
lapply(x, print, ...)
}
if (isTRUE(settings$error_on_lint)) {
quit("no", 31L, FALSE) # nocov
}
} else if (use_rstudio_source_markers) {
# Empty lints: clear RStudio source markers
rstudio_source_markers(x)
}
invisible(x)
}
trim_output <- function(x, max = 65535L) {
# if x is less than the max, just return it
if (length(x) <= 0L || nchar(x) <= max) {
return(x)
}
# otherwise trim x to the max, then search for the lint starts
x <- substr(x, 1L, max)
re <- rex(
"[", except_some_of(":"), ":", numbers, ":", numbers, ":", "]",
"(", except_some_of(")"), ")",
space,
"*", or("style", "warning", "error"), ":", "*",
except_some_of("\r\n"), newline,
except_some_of("\r\n"), newline,
except_some_of("\r\n"), newline,
except_some_of("\r\n"), newline,
except_some_of("\r\n"), newline
)
lint_starts <- re_matches(x, re, global = TRUE, locations = TRUE)[[1L]]
# if at least one lint ends before the cutoff, cutoff there, else just use
# the cutoff
last_end <- lint_starts[NROW(lint_starts), "end"]
if (!is.na(last_end)) {
substr(x, 1L, last_end)
} else {
x
}
}
#' @export
names.lints <- function(x, ...) {
vapply(x, `[[`, character(1L), "filename")
}
#' @export
split.lints <- function(x, f = NULL, ...) {
if (is.null(f)) f <- names(x)
splt <- split.default(x, f)
for (i in names(splt)) class(splt[[i]]) <- "lints"
return(splt)
}
#' @export
as.data.frame.lints <- function(x, row.names = NULL, optional = FALSE, ...) { # nolint: object_name. (row.names, #764)
data.frame(
filename = vapply(x, `[[`, character(1L), "filename"),
line_number = vapply(x, `[[`, integer(1L), "line_number"),
column_number = vapply(x, `[[`, integer(1L), "column_number"),
type = vapply(x, `[[`, character(1L), "type"),
message = vapply(x, `[[`, character(1L), "message"),
line = vapply(x, `[[`, character(1L), "line"),
linter = vapply(x, `[[`, character(1L), "linter"),
stringsAsFactors = FALSE
)
}
as_tibble.lints <- function(x, ..., # nolint: object_name_linter.
.rows = NULL,
.name_repair = c("check_unique", "unique", "universal", "minimal"),
rownames = NULL) {
stopifnot(requireNamespace("tibble", quietly = TRUE))
tibble::as_tibble(as.data.frame(x), ..., .rows = .rows, .name_repair = .name_repair, rownames = rownames)
}
as.data.table.lints <- function(x, keep.rownames = FALSE, ...) { # nolint: object_name_linter.
stopifnot(requireNamespace("data.table", quietly = TRUE))
data.table::setDT(as.data.frame(x), keep.rownames = keep.rownames, ...)
}
#' @export
`[.lints` <- function(x, ...) {
attrs <- attributes(x)
x <- unclass(x)
x <- x[...]
attributes(x) <- attrs
x
}
#' @export
summary.lints <- function(object, ...) {
filenames <- vapply(object, `[[`, character(1L), "filename")
types <- factor(vapply(object, `[[`, character(1L), "type"),
levels = c("style", "warning", "error")
)
tbl <- table(filenames, types)
filenames <- rownames(tbl)
res <- as.data.frame.matrix(tbl, stringsAsFactors = FALSE, row.names = NULL)
res$filenames <- filenames %||% character()
nms <- colnames(res)
res[order(res$filenames), c("filenames", nms[nms != "filenames"])]
}
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.