Split get_source_file into it's own function

Mainly to make debugging a little easier.

Also improve the documentation for lint and add some simple package
documentation.

R/get_source_expressions.R

@@ -70,17 +70,9 @@ get_source_expressions <- function(filename) {
  )
  }
 
- e <- tryCatch(
- source_file$parse <- parse(text=source_file$content, srcfile=source_file, keep.source = TRUE),
- error = lint_error)
-
- # This needs to be done twice to avoid
- # https://bugs.r-project.org/bugzilla/show_bug.cgi?id=16041
- e <- tryCatch(
- source_file$parse <- parse(text=source_file$content, srcfile=source_file, keep.source = TRUE),
- error = lint_error)
+ e <- NULL
 
- parsed_content <- fix_eq_assign(adjust_columns(getParseData(source_file)))
+ parsed_content <- get_source_file(filename, error = lint_error)
 
  tree <- generate_tree(parsed_content)
 
@@ -119,6 +111,29 @@ get_source_expressions <- function(filename) {
  list(expressions = expressions, error = e, lines = lines)
 }
 
+get_source_file <- function(filename, error = identity) {
+
+ source_file <- srcfile(filename)
+ lines <- readLines(filename)
+ source_file$content <- paste0(collapse = "\n", lines)
+
+ e <- tryCatch(
+ source_file$parse <- parse(text=source_file$content, srcfile=source_file, keep.source = TRUE),
+ error = error)
+
+ # This needs to be done twice to avoid
+ # https://bugs.r-project.org/bugzilla/show_bug.cgi?id=16041
+ e <- tryCatch(
+ source_file$parse <- parse(text=source_file$content, srcfile=source_file, keep.source = TRUE),
+ error = error)
+
+ if (!inherits(e, "expression")) {
+ assign("e", e, envir=parent.frame())
+ }
+
+ fix_eq_assign(adjust_columns(getParseData(source_file)))
+}
+
 find_line_fun <- function(content) {
  newline_search <-
  re_matches(content,

R/lint.R

@@ -1,5 +1,13 @@
-#' Lint a file
+#' Lintr
 #'
+#' Static code analysis to find errors in style, syntax and semantics.
+#' @name lintr
+#' @seealso \code{\link{lint}}, \code{\link{lint_package}}, \code{\link{linters}}
+NULL
+
+#' Lint a given file
+#'
+#' Apply one or more linters to a file and return a list of lints found.
 #' @param filename the given filename to lint.
 #' @param linters a list of linter functions to apply see \code{\link{linters}}
 #' for a full list of default and available linters.
@@ -66,8 +74,9 @@ reorder_lints <- function(lints) {
  ]
 }
 
-#' Lint all files in a package
+#' Lint a package
 #'
+#' Apply one or more linters to all of the R files in a package.
 #' @param path the path to the base directory of the package, if \code{NULL},
 #' the base directory will be searched for by looking in the parent directories
 #' of the current directory.
@@ -181,12 +190,6 @@ print.lints <- function(x, ...) {
 
 highlight_string <- function(message, column_number = NULL, ranges = NULL) {
 
- #adjust <- adjust_position_fun(message)
-
- #column_number <- adjust(column_number)
-
- #ranges[] <- lapply(ranges, adjust)
-
  maximum <- max(column_number, unlist(ranges))
 
  line <- fill_with(" ", maximum)
@@ -201,51 +204,6 @@ highlight_string <- function(message, column_number = NULL, ranges = NULL) {
  line
 }
 
-adjust_position_fun <- function(message) {
- positions <- re_matches(
- encodeString(message),
- rex("\\" %if_prev_isnt% "\\",
-
- or(
-
- # ascii escapes
- one_of("nrtbafv\'\"\`\\"),
-
- # octal code
- group(range(0, 7) %>% between(1, 3)),
-
- # hex code
- group("x", one_of(digit, "abcdefABCDEF") %>% between(1, 2)),
-
- # unicode hex code
- group("u", one_of(digit, "abcdefABCDEF") %>% between(1, 4)),
-
- # extended unicode hex code
- group("U", one_of(digit, "abcdefABCDEF") %>% between(1, 8))
- )
- ),
- locations = TRUE,
- global = TRUE)[[1]]
-
- if (is.na(positions$end[1L])) {
- positions$length <- 0L
- }
- else {
- positions$length <- positions$end - positions$start
- }
-
- function(position) {
- escapes <- which(positions$start < position)
-
- if (escapes %==% integer(0)) {
- position
- }
- else {
- position + positions$length[which(positions$start < position)]
- }
- }
-}
-
 fill_with <- function(character = " ", length = 1L) {
  paste0(collapse = "", rep.int(character, length))
 }

man/lint_file.Rd

@@ -3,7 +3,7 @@
 \name{lint_file}
 \alias{lint}
 \alias{lint_file}
-\title{Lint a file}
+\title{Lint a given file}
 \usage{
 lint(filename, linters = default_linters, cache = FALSE)
 }
@@ -16,6 +16,6 @@ for a full list of default and available linters.}
 \item{cache}{toggle caching of lint results}
 }
 \description{
-Lint a file
+Apply one or more linters to a file and return a list of lints found.
 }
 

man/lint_package.Rd

@@ -2,7 +2,7 @@
 % Please edit documentation in R/lint.R
 \name{lint_package}
 \alias{lint_package}
-\title{Lint all files in a package}
+\title{Lint a package}
 \usage{
 lint_package(path = NULL, relative_path = TRUE, ...)
 }
@@ -18,6 +18,6 @@ absolute path.}
 \item{...}{additional arguments passed to \code{\link{lint}}}
 }
 \description{
-Lint all files in a package
+Apply one or more linters to all of the R files in a package.
 }
 

vignettes/creating_linters.Rmd

@@ -4,7 +4,8 @@ author: "Jim Hester"
 date: "`r Sys.Date()`"
 output: rmarkdown::html_vignette
 vignette: >
- %\VignetteIndexEntry{Creating new linters} %\VignetteEngine{knitr::rmarkdown}
+ %\VignetteIndexEntry{Creating new linters}
+ %\VignetteEngine{knitr::rmarkdown}
  \usepackage[utf8]{inputenc}
 ---
 
@@ -41,25 +42,29 @@ for use outside the package.
 #' @export
 ```
 
-Next we define the name of the new linter. All linter names are suffixed by `_linter`.
+Next we define the name of the new linter. The convention is that all linter
+names are suffixed by `_linter`.
 ```r
 assignment_linter <- function(source_file) {
 ```
 
-Next we need to figure out what tokens we want to check for linting. These
-tokens are obtained by previous `parse()` and `getParseData()` calls prior to
-calling the new linter. `getParseData()` returns a `data.frame` with information
-from the source parse tree of the file being linted. This data is stored in
-`source_file$parsed_content`. The raw text of the file is also available with
-`source_file$content`, however it is recommended to work with the tokens from
-`source_file$parsed_content` if possible, as it is more robust. The list of
-tokens is in
+Your linter will be called by each top level expression in the file to be
+linted.
+
+The raw text of the expression is available from `source_file$content`. However it is
+recommended to work with the tokens from
+`source_file$parsed_content` if possible, as they are tokenzied from the `R`
+parser. These tokens are obtained from `parse()` and `getParseData()`
+calls done prior to calling the new linter. `getParseData()` returns a `data.frame`
+with information from the source parse tree of the file being linted. A list of
+tokens available from
 [r-source/src/main/gram.y](https://github.com/wch/r-source/blob/ff1bca2f21aba271d428474f00494eece5c36dd3/src/main/gram.y#L293-L307).
 
 `ids_with_token()` can be used to search for a specific token and return the
 associated id. Note that the `rownames` for `parsed_content` are set to the
 `id`, so you can retrieve the rows for a given id with
 `source_file$parsed_content[id, ]`.
+
 ```r
 lapply(ids_with_token(source_file, "EQ_ASSIGN"),
  function(id) {
@@ -68,6 +73,7 @@ lapply(ids_with_token(source_file, "EQ_ASSIGN"),
 
 Lastly build a `Lint` object which describes the issue. See `?Lint` for a
 description of the arguments.
+
 ```r
 Lint(
  filename = source_file$filename,
@@ -80,13 +86,14 @@ Lint(
 ```
 
 You do not have to return a Lint for every iteration of your loop. Feel free
-to return `NULL` (or nothing) for tokens which do not need to be linted. You can
-even return a `list` of `Lint` objects.
+to return `NULL` or empty lists() for tokens which do not need to be linted.
+You can even return a `list` of `Lint` objects if more than one Lint was found.
 
 ## Writing linter tests ##
 The `linter` package uses [testthat](https://github.com/hadley/testthat) for
-testing. You can run all of the available tests using `devtools::test()`. If
-you want to run only the tests in a given file use the `filter` argument.
+testing. You can run all of the currently available tests using
+`devtools::test()`. If you want to run only the tests in a given file use the
+`filter` argument to `devtools::test()`.
 
 Linter tests should be put in the
 [tests/testthat/](https://github.com/jimhester/lintr/tree/master/tests/testthat)
@@ -106,28 +113,33 @@ test_that("returns the correct linting", {
 You then test a series of expectations for the linter using `expect_lint`.
 Please see `?expect_lint` for a full description of the parameters.
 
-I try to test 3 things.
+I try to test 3 main things.
+
+1. Linter returns no lints when there is nothing to lint. e.g.
+
+```r
+expect_lint("blah", NULL, assignment_linter)
+```
 
-1. Linter returns nothing when there is nothing to lint. e.g.
- ```r
- expect_lint("blah", NULL, assignment_linter)
- ```
 2. Linter returns a lint when there is something to lint. e.g.
- ```r
- expect_lint("blah=1",
- rex("Use <-, not =, for assignment."),
- assignment_linter)
- ```
+
+```r
+expect_lint("blah=1",
+ rex("Use <-, not =, for assignment."),
+ assignment_linter)
+```
+
 3. As many edge cases as you can think of that might break it. e.g.
- ```r
- expect_lint("fun((blah = fun(1)))",
- rex("Use <-, not =, for assignment."),
- assignment_linter)
- ```
+
+```r
+expect_lint("fun((blah = fun(1)))",
+ rex("Use <-, not =, for assignment."),
+ assignment_linter)
+```
 
 It is always better to write too many tests rather than too few.
 
-## Adding linter to the default_linters ##
+## Adding your linter to the default_linters ##
 If your linter is non-project specific you can add it to `default_linters`.
 This object is created in the file `zzz.R`. The name ensures that it will always run after all
 the linters are defined. Simply add your linter name to the `default_linters`
@@ -136,5 +148,4 @@ list before the `NULL` at the end.
 ## Submit pull request ##
 Push your changes to a branch of your fork of the
 [lintr](https://github.com/jimhester/lintr) repository, and submit a pull
-request to get your linter merged into lintr.
-
+request to get your linter merged into lintr!