Merge 1172732 into 1b95e15

NAMESPACE

@@ -3,9 +3,13 @@
 export(app)
 export(box_alphabetical_calls_linter)
 export(box_func_import_count_linter)
+export(box_pkg_fun_exists_linter)
 export(box_separate_calls_linter)
 export(box_trailing_commas_linter)
 export(box_universal_import_linter)
+export(box_unused_attached_fun_linter)
+export(box_unused_attached_pkg_linter)
+export(box_usage_linter)
 export(build_js)
 export(build_sass)
 export(diagnostics)
@@ -17,6 +21,8 @@ export(lint_sass)
 export(log)
 export(pkg_install)
 export(pkg_remove)
+export(r6_usage_linter)
 export(react_component)
 export(test_e2e)
 export(test_r)
+export(unused_declared_func_linter)

R/box_pkg_fun_exists_linter.R

@@ -0,0 +1,82 @@
+#' @export
+box_pkg_fun_exists_linter <- function() {
+  box_base_path <- "
+  //SYMBOL_PACKAGE[
+    text() = 'box' and
+    following-sibling::SYMBOL_FUNCTION_CALL[text() = 'use']
+  ]
+  /parent::expr
+  /parent::expr
+  "
+
+  box_package_functions <- "
+  /child::expr[
+    expr/SYMBOL and
+    OP-LEFT-BRACKET and
+    not(
+      expr[
+        preceding-sibling::OP-LEFT-BRACKET and
+        SYMBOL[
+          text() = '...'
+        ]
+      ]
+    )
+  ]
+  "
+
+  xpath_package_functions <- paste(box_base_path, box_package_functions)
+
+  lintr::Linter(function(source_expression) {
+    if (!lintr::is_lint_level(source_expression, "file")) {
+      return(list())
+    }
+
+    xml <- source_expression$full_xml_parsed_content
+
+    pkg_fun_not_exists <- check_attached_pkg_funs(xml, xpath_package_functions)
+
+    lapply(pkg_fun_not_exists$xml, function(xml_node) {
+      lintr::xml_nodes_to_lints(
+        xml_node,
+        source_expression = source_expression,
+        lint_message = "Function not exported by package.",
+        type = "warning"
+      )
+    })
+  })
+}
+
+check_attached_pkg_funs <- function(xml, xpath) {
+  pkg_imports <- xml2::xml_find_all(xml, xpath)
+
+  xpath_pkg_names <- "
+    expr/SYMBOL[
+      parent::expr/following-sibling::OP-LEFT-BRACKET
+    ]"
+
+  xpath_just_functions <- "
+      expr[
+        preceding-sibling::OP-LEFT-BRACKET and
+        following-sibling::OP-RIGHT-BRACKET
+      ]
+      /SYMBOL[
+        not(
+          text() = '...'
+        )
+      ]
+    "
+
+  not_exported <- lapply(pkg_imports, function(pkg_import) {
+    xml2::xml_find_all(pkg_import, xpath_just_functions)
+
+    packages <- extract_xml_and_text(pkg_import, xpath_pkg_names)
+    exported_functions <- unlist(get_packages_exports(packages$text))
+    attached_functions <- extract_xml_and_text(pkg_import, xpath_just_functions)
+
+    attached_functions$xml[!attached_functions$text %in% exported_functions]
+  })
+
+  list(
+    xml = not_exported
+  )
+}

R/box_unused_attached_fun_linter.R

@@ -0,0 +1,27 @@
+#' @export
+box_unused_attached_fun_linter <- function() {
+  lintr::Linter(function(source_expression) {
+    if (!lintr::is_lint_level(source_expression, "file")) {
+      return(list())
+    }
+
+    xml <- source_expression$full_xml_parsed_content
+
+    attached_functions <- get_attached_functions(xml)
+    function_calls <- get_function_calls(xml)
+
+    lapply(attached_functions$xml, function(fun_import) {
+      fun_import_text <- xml2::xml_text(fun_import)
+      fun_import_text <- gsub("[`'\"]", "", fun_import_text)
+
+      if (!fun_import_text %in% function_calls$text) {
+        lintr::xml_nodes_to_lints(
+          fun_import,
+          source_expression = source_expression,
+          lint_message = "Imported function unused.",
+          type = "warning"
+        )
+      }
+    })
+  })
+}

R/box_unused_attached_pkg_linter.R

@@ -0,0 +1,53 @@
+#' @export
+box_unused_attached_pkg_linter <- function() {
+  lintr::Linter(function(source_expression) {
+    if (!lintr::is_lint_level(source_expression, "file")) {
+      return(list())
+    }
+
+    xml <- source_expression$full_xml_parsed_content
+
+    attached_packages <- get_attached_packages(xml)
+    attached_three_dots <- get_attached_three_dots(xml)
+    function_calls <- get_function_calls(xml)
+
+    unused_package <- lapply(attached_packages$xml, function(attached_package) {
+      package_text <- lintr::get_r_string(attached_package)
+
+      func_list <- paste(package_text, attached_packages$nested[[package_text]], sep = "$")
+
+      functions_used <- length(intersect(func_list, function_calls$text))
+
+      if (functions_used == 0) {
+        lintr::xml_nodes_to_lints(
+          attached_package,
+          source_expression = source_expression,
+          lint_message = "Attached package unused.",
+          type = "warning"
+        )
+      }
+    })
+
+    unused_three_dots <- lapply(attached_three_dots$xml, function(attached_package) {
+      package_text <- lintr::get_r_string(attached_package)
+
+      func_list <- attached_three_dots$nested[[package_text]]
+
+      functions_used <- length(intersect(func_list, function_calls$text))
+
+      if (functions_used == 0) {
+        lintr::xml_nodes_to_lints(
+          attached_package,
+          source_expression = source_expression,
+          lint_message = "Three-dots attached package unused.",
+          type = "warning"
+        )
+      }
+    })
+
+    c(
+      unused_package,
+      unused_three_dots
+    )
+  })
+}

R/box_usage_helper_functions.R

@@ -0,0 +1,152 @@
+box_base_path <- function() {
+  "//SYMBOL_PACKAGE[(text() = 'box' and following-sibling::SYMBOL_FUNCTION_CALL[text() = 'use'])]
+  /parent::expr
+  /parent::expr
+  "
+}
+
+extract_xml_and_text <- function(xml, xpath) {
+  xml_nodes <- xml2::xml_find_all(xml, xpath)
+  text <- lintr::get_r_string(xml_nodes)
+  text <- gsub("[`'\"]", "", text)
+
+  list(
+    xml_nodes = xml_nodes,
+    text = text
+  )
+}
+
+get_attached_functions <- function(xml, xpath) {
+  xpath_just_functions <- "
+  /child::expr[
+    expr/SYMBOL and
+    OP-LEFT-BRACKET and
+    not(
+      expr[
+        preceding-sibling::OP-LEFT-BRACKET and
+        SYMBOL[
+          text() = '...'
+        ]
+      ]
+    )
+  ]
+
+  /expr[
+    preceding-sibling::OP-LEFT-BRACKET and
+    following-sibling::OP-RIGHT-BRACKET
+  ]
+  /SYMBOL[
+    not(
+      text() = '...'
+    )
+  ]
+"
+
+  xpath_attached_functions <- paste(box_base_path(), xpath_just_functions)
+  attached_functions <- extract_xml_and_text(xml, xpath_attached_functions)
+
+  list(
+    xml = attached_functions$xml_nodes,
+    text = attached_functions$text
+  )
+}
+
+get_attached_three_dots <- function(xml) {
+  box_package_three_dots <- "
+  /child::expr[
+    expr/SYMBOL[text() = '...']
+  ]
+  /expr[
+    following-sibling::OP-LEFT-BRACKET
+  ]
+  /SYMBOL
+  "
+
+  xpath_package_three_dots <- paste(box_base_path(), box_package_three_dots)
+  attached_three_dots <- extract_xml_and_text(xml, xpath_package_three_dots)
+  nested_list <- get_packages_exports(attached_three_dots$text)
+  flat_list <- unlist(nested_list, use.names = FALSE)
+
+  list(
+    xml = attached_three_dots$xml_nodes,
+    nested = nested_list,
+    text = flat_list
+  )
+}
+
+get_attached_packages <- function(xml) {
+  box_package_import <- "
+  /child::expr[
+    SYMBOL
+  ]
+  "
+
+  xpath_package_import <- paste(box_base_path(), box_package_import)
+  attached_packages <- extract_xml_and_text(xml, xpath_package_import)
+  nested_list <- get_packages_exports(attached_packages$text)
+
+  flat_list <- unlist(
+    lapply(names(nested_list), function(pkg) {
+      paste(
+        pkg,
+        nested_list[[pkg]],
+        sep = "$"
+      )
+    })
+  )
+
+  list(
+    xml = attached_packages$xml_nodes,
+    nested = nested_list,
+    text = flat_list
+  )
+}
+
+get_declared_functions <- function(xml) {
+  xpath_function_assignment <- "
+  //expr[
+      (LEFT_ASSIGN or EQ_ASSIGN) and ./expr[2][FUNCTION or OP-LAMBDA]
+    ]
+    /expr[1]/SYMBOL
+  | //expr_or_assign_or_help[EQ_ASSIGN and ./expr[2][FUNCTION or OP-LAMBDA]]
+  | //equal_assign[EQ_ASSIGN and ./expr[2][FUNCTION or OP-LAMBDA]]
+  | //SYMBOL_FUNCTION_CALL[text() = 'assign']/parent::expr[
+      ./following-sibling::expr[2][FUNCTION or OP-LAMBDA]
+    ]
+    /following-sibling::expr[1]/STR_CONST
+  "
+
+  extract_xml_and_text(xml, xpath_function_assignment)
+}
+
+get_function_calls <- function(xml) {
+  xpath_box_function_calls <- "
+  //expr[
+    SYMBOL_FUNCTION_CALL[
+      not(text() = 'use')
+    ] and
+    not(
+      SYMBOL_PACKAGE[text() = 'box']
+    )
+  ] |
+  //SPECIAL
+  "
+
+  # lintr::get_r_string throws an error when seeing SYMBOL %>%
+  xml_nodes <- xml2::xml_find_all(xml, xpath_box_function_calls)
+  text <- xml2::xml_text(xml_nodes, trim = TRUE)
+  r6_refs <- internal_r6_refs(text)
+
+  xml_nodes <- xml_nodes[!r6_refs]
+  text <- text[!r6_refs]
+
+  list(
+    xml_nodes = xml_nodes,
+    text = text
+  )
+}
+
+internal_r6_refs <- function(func_list) {
+  r6_refs <- "self|private\\$.+"
+  grepl(r6_refs, func_list)
+}