exclusions and setting configurations

.lintr

@@ -1 +1 @@
-with_defaults(line_length_linter(120))
+linters: with_defaults(line_length_linter(120))

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: lintr
 Title: Static R Code Analysis
-Version: 0.2.1.9000
+Version: 0.3.0.9000
 Authors@R: "Jim Hester <james.f.hester@gmail.com> [aut, cre]"
 URL: https://github.com/jimhester/lintr
 BugReports: https://github.com/jimhester/lintr/issues

NAMESPACE

@@ -1,12 +1,15 @@
 # Generated by roxygen2 (4.1.0): do not edit by hand
 
+S3method("[",lints)
+S3method(as.data.frame,lints)
 S3method(names,lints)
 S3method(print,lint)
 S3method(print,lints)
 S3method(split,lints)
 export(Lint)
 export(absolute_paths_linter)
 export(assignment_linter)
+export(camel_case_linter)
 export(clear_cache)
 export(closed_curly_linter)
 export(commas_linter)
@@ -16,14 +19,13 @@ export(infix_spaces_linter)
 export(line_length_linter)
 export(lint)
 export(lint_package)
+export(multiple_dots_linter)
 export(no_tab_linter)
-export(object_camel_case_linter)
 export(object_length_linter)
-export(object_multiple_dots_linter)
-export(object_snake_case_linter)
 export(object_usage_linter)
 export(open_curly_linter)
 export(single_quotes_linter)
+export(snake_case_linter)
 export(spaces_inside_linter)
 export(spaces_left_parentheses_linter)
 export(trailing_blank_lines_linter)

NEWS.md

@@ -1,9 +1,13 @@
-# lintr 0.2.0.9000 #
+# lintr 0.3.0.9000 #
 
+* Emacs and Sublime Text 3 plugins now available from their respective package repositories.
+* add `names.lints`, `split.lints` (#49, @ttriche)
+* Fixed bug that caused vim syntatic plugin not to work properly in windows (#46, @abossenbroek)
+* allow lintr customization per project using `.lintr` config files.
 * use `globalenv()` instead of `baseenv()` for default parent environment so
   that `methods` will be included.
 * do not check object usage if eval fails.  Fixes (#24, reported by @fabian-s)
-* trailing_whitespace_linter was reporting the incorrect line number
+* `trailing_whitespace_linter` was reporting the incorrect line number
 * Use RStudio source marker API to display lints (#37, @jjallaire)
 * Permit single quotes if they quote literal double quotes (#28, @jackwasey)
 

R/exclude.R

@@ -0,0 +1,125 @@
+exclude <- function(lints, exclusions = NULL, ...) {
+  df <- as.data.frame(lints)
+
+  filenames <- unique(df$filename)
+
+  full_filenames <-
+    if (!is.null(attr(lints, "path"))) {
+      file.path(attr(lints, "path"), filenames)
+    } else {
+      filenames
+    }
+
+  source_exclusions <- lapply(full_filenames, parse_exclusions, ...)
+  names(source_exclusions) <- filenames
+
+  excl <- normalize_exclusions(c(source_exclusions, exclusions))
+
+  to_exclude <- vapply(seq_len(NROW(df)),
+    function(i) {
+      file <- df$filename[i]
+      file %in% names(excl) &&
+        excl[[file]] == Inf |
+        df$line_number[i] %in% excl[[file]]
+     },
+    logical(1))
+
+  if (any(to_exclude)) {
+    lints <- lints[!to_exclude]
+  }
+
+  lints
+}
+#' read a source file and parse all the excluded lines from it
+#'
+#' @param file R source file
+#' @param exclude regular expression used to mark lines to exclude
+#' @param exclude_start regular expression used to mark the start of an excluded range
+#' @param exclude_end regular expression used to mark the end of an excluded range
+parse_exclusions <- function(file, exclude = settings$exclude,
+                             exclude_start = settings$exclude_start,
+                             exclude_end = settings$exclude_end) {
+  lines <- readLines(file)
+
+  exclusions <- numeric(0)
+
+  starts <- which(rex::re_matches(lines, exclude_start))
+  ends <- which(rex::re_matches(lines, exclude_end))
+
+  if (length(starts) > 0) {
+    if (length(starts) != length(ends)) {
+      stop(file, " has ", length(starts), " starts but only ", length(ends), " ends!")
+    }
+
+    for(i in seq_along(starts)) {
+      exclusions <- c(exclusions, seq(starts[i], ends[i]))
+    }
+  }
+
+  sort(unique(c(exclusions, which(rex::re_matches(lines, exclude)))))
+}
+
+normalize_exclusions <- function(x) {
+  if (is.null(x) || length(x) <= 0) {
+    return(list())
+  }
+
+  # no named parameters at all
+  if (is.null(names(x))) {
+    x <- structure(relist(rep(Inf, length(x)), x), names = x)
+  } else {
+    unnamed <- names(x) == ""
+    if (any(unnamed)) {
+
+      # must be character vectors of length 1
+      bad <- vapply(seq_along(x), 
+        function(i) {
+          unnamed[i] & (!is.character(x[[i]]) | length(x[[i]]) != 1)
+        },
+        logical(1))
+
+      if (any(bad)) {
+        stop("Full file exclusions must be character vectors of length 1. items: ",
+             paste(collapse = ", ", which(bad)),
+             " are not!",
+             call. = FALSE)
+      }
+      names(x)[unnamed] <- x[unnamed]
+      x[unnamed] <- Inf
+    }
+  }
+
+  remove_line_duplicates(
+    remove_file_duplicates(
+      remove_empty(x)
+    )
+  )
+}
+
+remove_file_duplicates <- function(x) {
+  unique_names <- unique(names(x))
+  if (length(unique_names) < length(names(x))) { # must be duplicate files
+    x <- lapply(unique_names, 
+                function(name) {
+                  vals <- unname(unlist(x[names(x) == name]))
+                  if (any(vals == Inf)) {
+                    Inf
+                  } else {
+                    vals
+                  }
+                })
+
+    names(x) <- unique_names
+  }
+
+  x
+}
+
+remove_line_duplicates <- function(x) {
+  x[] <- lapply(x, unique)
+
+  x
+}
+remove_empty <- function(x) {
+  x[vapply(x, length, numeric(1)) > 0]
+}

R/expect_lint.R

@@ -10,8 +10,13 @@
 #'   \item list-vectors check if the given lint matches (use if more than one lint is returned for the content)
 #' }
 #' @param ... one or more linters to use for the check
-expect_lint <- function(content, checks, ...) {
+#' @param file if not \code{NULL} read content from a file rather than from \code{content}
+expect_lint <- function(content, checks, ..., file = NULL) {
 
+  if (!is.null(file)) {
+    content <- readChar(file, file.info(file)$size)
+  }
+
   results <- expectation_lint(content, checks, ...)
 
   reporter <- testthat::get_reporter()
@@ -65,7 +70,7 @@ expectation_lint <- function(content, checks, ...) {
           " lints as expected from content:", content, lints)))
   }
 
-  itr <- 0L
+  itr <- 0L #nolint
   mapply(function(lint, check) {
     itr <- itr + 1L
     lapply(names(check), function(field) {
@@ -107,3 +112,10 @@ expectation_lint <- function(content, checks, ...) {
   lints,
   checks)
 }
+
+#' Lint free expectation
+#'
+#' @inheritParams expect_lint
+expect_lint_free <- function(content, ...) {
+  expect_lint(content, NULL, ...)
+}

R/lint.R

@@ -14,12 +14,24 @@ NULL
 #' @param linters a list of linter functions to apply see \code{\link{linters}}
 #' for a full list of default and available linters.
 #' @param cache toggle caching of lint results
+#' @param exclusions additional lines or files to exclude.
+#' @param ... additional arguments passed to \code{\link{parse_exclusions}}.
+#' @section Exclusions:
+#' Exclusions can be specified in three different ways.
+#' \enumerate{
+#' \item{single line in the source file. default: \code{# nolint}}
+#' \item{line range in the source file. default: \code{# nolint start}, \code{# nolint end}}
+#' \item{exclusions parameter, a named list of the files and lines to exclude, or just the filenames 
+#' if you want to exclude the entire file.}
+#' }
 #' @export
 #' @name lint_file
-lint <- function(filename, linters = NULL, cache = FALSE) {
+lint <- function(filename, linters = NULL, cache = FALSE, exclusions = NULL, ...) {
 
+  read_settings(filename)
+
   if (is.null(linters)) {
-    linters <- find_default_linters(filename)
+    linters <- settings$linters
   } else if (!is.list(linters)) {
     name <- deparse(substitute(linters))
    linters <- list(linters)
@@ -72,48 +84,7 @@ lint <- function(filename, linters = NULL, cache = FALSE) {
     save_cache(lint_cache, filename)
   }
 
-  lints
-}
-
-#' Specifying default linters
-#' 
-#' Lintr searches for default linters for a given file in the following order.
-#' \enumerate{
-#'   \item specified using the \code{lintr.linters} option.
-#'   \item \code{linter_file} in the same directory
-#'   \item \code{linter_file} in the project directory
-#'   \item \code{\link{default_linters}}
-#' }
-#' 
-#' The default linter_file name is \code{.lintr} but it can be changed with option 
-#' \code{lintr.linter_file}.
-#' @param filename source file to be linted
-find_default_linters <- function(filename) {
-
-  ## If the linters option is set use that
-  linter_config <- getOption("lintr.linters")
-  if (!is.null(linter_config)) {
-    return(linter_config)
-  }
-
-  path <- dirname(filename)
-  linter_file <- getOption("lintr.linter_file")
-
-  ## next check for a .linters file in the current directory
-  linter_config <- file.path(path, linter_file)
-  if (isTRUE(file.exists(linter_config))) {
-    return(source(linter_config)$value)
-  }
-
-  ## next check for a .linters file in the project directory
-  project <- find_package(path)
-  linter_config <- file.path(project, linter_file)
-  if (isTRUE(file.exists(linter_config))) {
-    return(source(linter_config)$value)
-  }
-
-  ## lastly use the default linters
-  default_linters
+  exclude(lints, exclusions, ...)
 }
 
 reorder_lints <- function(lints) {
@@ -166,16 +137,17 @@ lint_package <- function(path = NULL, relative_path = TRUE, ...) {
     message()
   }
 
+  lints <- reorder_lints(lints)
+
   if (relative_path == TRUE) {
     lints[] <- lapply(lints,
       function(x) {
         x$filename <- re_substitutes(x$filename, rex(path, one_of("/", "\\")), "")
         x
       })
-    attr(lints, "package_path") <- path
+    attr(lints, "path") <- path
   }
-
-  lints <- reorder_lints(lints)
+
   class(lints) <- "lints"
   lints
 }
@@ -236,7 +208,7 @@ Lint <- function(filename, line_number = 1L, column_number = NULL,
 rstudio_source_markers <- function(lints) {
 
   # package path will be NULL unless it is a relative path
-  package_path <- attr(lints, "package_path")
+  package_path <- attr(lints, "path")
 
   # generate the markers
   markers <- lapply(lints, function(x) {

R/methods.R

@@ -44,3 +44,24 @@ split.lints <- function(x, f=NULL, ...) {
   for(i in names(splt)) class(splt[[i]]) <- "lints"
   return(splt)
 }
+
+#' @export
+as.data.frame.lints <- function(x, row.names = NULL, optional = FALSE, ...) {
+  data.frame(filename = vapply(x, `[[`, character(1), "filename"),
+             line_number = vapply(x, `[[`, numeric(1), "line_number"),
+             column_number = vapply(x, `[[`, numeric(1), "column_number"),
+             type = vapply(x, `[[`, character(1), "type"),
+             message = vapply(x, `[[`, character(1), "message"),
+             line = vapply(x, `[[`, character(1), "line"),
+             stringsAsFactors = FALSE
+  )
+}
+
+#' @export
+`[.lints` <- function(x, ...) {
+  attrs <- attributes(x)
+  x <- unclass(x)
+  x <- x[...]
+  attributes(x) <- attrs
+  x
+}