Allow lint results to be exported as checkstyle xml

Author: joshkgold

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: lintr
 Title: Static R Code Analysis
-Version: 1.0.0.9000
+Version: 1.0.0.9001
 Authors@R: person("Jim", "Hester", email = "[email protected]", role = c("aut", "cre"))
 URL: https://github.com/jimhester/lintr
 BugReports: https://github.com/jimhester/lintr/issues

NAMESPACE

@@ -10,6 +10,7 @@ export(Lint)
 export(absolute_paths_linter)
 export(assignment_linter)
 export(camel_case_linter)
+export(checkstyle_output)
 export(clear_cache)
 export(closed_curly_linter)
 export(commas_linter)

R/lint.R

@@ -252,6 +252,44 @@ rstudio_source_markers <- function(lints) {
                       autoSelect = "first")
 }
 
+#' Checkstyle Report for lint results
+#' 
+#' Generate a report of the linting results using the Checkstyle xml format
+#' @param lints the linting results.
+#' @param reportName the name of the output report.  It will be generated and stored
+#'                    in a reports/ directory.
+#' @export
+checkstyle_output <- function(lints, reportName = "lint_checkstyle_results.xml") {
+
+  # Auto-create a results directory, if one has no existed previously
+  if (!dir.exists("results")) {
+    dir.create("results")
+  }
+  reportPath = paste("results/", reportName, sep = "")
+  file.create(reportPath)
+
+  # setup file
+  cat("<?xml version=\"1.0\" encoding=\"utf-8\"?>", file = reportPath, sep = "\n", append = TRUE)
+  cat("<checkstyle version=\"4.3\">", file = reportPath, sep = "\n", append = TRUE)
+
+  # output the style markers to the file
+  lapply(lints, function(x) {
+    # Need to replace left carat for xml report
+    msg <- sub("<", "&gt;", x$message)
+
+    filemsg = paste("\t<file name=\"", x$filename, "\">", sep = "")
+    cat(filemsg, file = reportPath, "\n", append = TRUE)
+
+    errmsg = paste("\t\t<error line=\"", x$line_number,"\" column=\"", x$column,
+                   "\" severity=\"error\" message=\"",msg,"\" />", sep = "")
+    cat(errmsg, file = reportPath, sep = "\n", append = TRUE)
+
+    cat("\t</file>", file = reportPath, sep = "\n", append = TRUE)
+  })
+
+  cat("</checkstyle>", file = reportPath, sep = "\n", append = TRUE)
+}
+
 highlight_string <- function(message, column_number = NULL, ranges = NULL) {
 
   maximum <- max(column_number, unlist(ranges))

tests/testthat/test-checkstyle_output.R

@@ -0,0 +1,30 @@
+library(XML)
+context("checkstyle_output")
+test_that("return lint report as checkstyle xml", {
+  with_mock(`rstudioapi::callFun` = function(...) return(list(...)),
+    lints <- structure(
+      list(
+        Lint(filename = "test_file",
+             line_number = 1,
+             column_number = 2,
+             type = "error",
+             line = "a line",
+             message = "hi")
+      ),
+      class = "lints"
+    ),
+    checkstyle_output(lints, "test-checkstyle.xml"),
+    expect_true(file.exists("results/test-checkstyle.xml"))
+  )
+  
+  xmlfile <- xmlTreeParse("results/test-checkstyle.xml")
+  topxml <- xmlRoot(xmlfile)
+  topxmlStr <- toString.XMLNode(topxml)
+  expect_equal(topxmlStr,
+                  "<checkstyle version=\"4.3\">\n <file name=\"test_file\">\n  <error line=\"1\" column=\"2\" severity=\"error\" message=\"hi\"/>\n </file>\n</checkstyle>"
+              )
+  
+  #clean up
+  file.remove("results/test-checkstyle.xml")
+  file.remove("results")
+})