Merge pull request #4 from MilesMcBain/master

add ability for using to detect calls to using::pkg in .R and .Rmd

DESCRIPTION

@@ -1,7 +1,7 @@
 Package: using
 Type: Package
 Title: Add version constraints to library() calls
-Version: 0.3.0
+Version: 0.4.0
 Authors@R: c(
     person(given = "Anthony", family = "North", role = c("aut", "cre"), email = "[email protected]"),
     person(given = "Miles", family = "McBain", role = c("aut"), email = "[email protected]"),
@@ -19,4 +19,9 @@ Depends: R (>= 3.3.0)
 Imports:
     utils,
     uuid,
-    remotes
+    remotes,
+    knitr,
+    stats,
+    withr
+Suggests: 
+    testthat (>= 2.1.0)

NAMESPACE

@@ -1,4 +1,5 @@
 # Generated by roxygen2: do not edit by hand
 
+export(detect_dependencies)
 export(pkg)
 export(using)

R/detect_dependencies.R

@@ -0,0 +1,135 @@
+##' detect usage of using::pkg in a source file
+##'
+##' Intended for use when building lock files (e.g. for {renv}) from source
+##' files.
+##'
+##' returns a data.frame of all information in using::pkg calls with columns:
+##' `package`, `min_version`, `repo`. The value of a row may be NA if the
+##' argument was not supplied.
+##'
+##' Each result row is guaranteed to be unique, however the result data frame may
+##' contain near duplicates, e.g. using::pkg(janitor, min_version = "2.0.1") and
+##' using::pkg(janitor, min_version = "1.0.0") would each create a row in the
+##' result data frame if they appeared in the same file, due to differing
+##' min_version.
+##'
+##' Each using::pkg call is parsed based on it's literal expression and no variable
+##' substitution is done. So using(janitor, min_version = janitor_ver) would
+##' place "janitor_ver" in the min_row column of the result for this dependency.
+##'
+##' @title detect_dependencies
+##' @param file_path a length 1 character vector file path to an .R or .Rmd file
+##' @return a data.frame summarising found using::pkg calls in the supplied file.
+##' @author Miles McBain
+##' @export
+detect_dependencies <- function(file_path) {
+  if (length(file_path) > 1) stop("file_path must be single file path not a vector of length > 1")
+
+  if (!file.exists(file_path)) stop("could not find file ", file_path)
+
+  file_type <-
+    tolower(
+      regmatches(
+        file_path,
+        regexpr("\\.[A-Za-z0-9]{1,3}$", file_path)
+      )
+    )
+
+  if (!(file_type %in% c(".r", ".rmd"))) stop("detect_dependencies only supported for .R and .Rmd")
+
+  deps <- switch(file_type,
+    .r = parse_detect_deps(file_path, parse),
+    .rmd = parse_detect_deps(file_path, parse_rmd),
+    NULL
+  )
+
+  deps[!duplicated(deps), ]
+}
+
+parse_detect_deps <- function(file_path, file_parser) {
+  syntax_tree <- tryCatch(file_parser(file = file_path),
+    error = function(e) stop("Could not detect usage of using::pkg in due to invalid R code. The parser returned: \n", e$message)
+  )
+
+  get_using(syntax_tree)
+}
+
+parse_rmd <- function(file_path) {
+  R_temp <- tempfile(fileext = ".R")
+  on.exit(unlink(R_temp))
+
+  withr::with_options(
+    list(knitr.purl.inline = TRUE),
+    knitr::purl(file_path,
+      output = R_temp,
+      quiet = TRUE
+    )
+  )
+
+  parse(file = R_temp)
+}
+
+
+is_using_node <- function(ast_node) {
+  node_list <- as.list(ast_node)
+  name_node <- as.character(node_list[[1]])
+
+  length(name_node) == 3 &&
+    name_node[[1]] == "::" &&
+    name_node[[2]] == "using" &&
+    name_node[[3]] == "pkg"
+}
+
+extract_using_data <- function(ast_node) {
+  node_list <- as.list(ast_node)
+  node_list <- node_list[-1]
+  char_nodes <- stats::setNames(
+    lapply(node_list, as.character),
+    names(node_list)
+  )
+
+
+  do.call(
+    function(package = NA_character_,
+             min_version = NA_character_,
+             repo = NA_character_) {
+      data.frame(
+        package = package,
+        min_version = min_version,
+        repo = repo,
+        stringsAsFactors = FALSE
+      )
+    },
+    char_nodes
+  )
+}
+
+get_using <- function(syntax_tree) {
+  get_using_recurse <- function(syntax_tree_expr) {
+    if (is.call(syntax_tree_expr)) {
+      if (is_using_node(syntax_tree_expr)) {
+        return(extract_using_data(syntax_tree_expr))
+      } else {
+        make_data_frame(lapply(syntax_tree_expr, get_using_recurse))
+      }
+    } else {
+      return(NULL)
+    }
+  }
+
+  make_data_frame(lapply(syntax_tree, get_using_recurse))
+}
+
+make_data_frame <- function(x) {
+  result_dfs <- x[!unlist(lapply(x, is.null))]
+
+  if (length(result_dfs) > 0) {
+    do.call(rbind, c(result_dfs, stringsAsFactors = FALSE))
+  } else {
+    data.frame(
+      package = character(0),
+      min_version = character(0),
+      repo = character(0), stringsAsFactors = FALSE
+    )
+  }
+}

tests/testthat.R

@@ -0,0 +1,4 @@
+library(testthat)
+library(using)
+
+test_check("using")

tests/testthat/test-detect-using-dependencies.R

@@ -0,0 +1,61 @@
+test_that("detecting using works", {
+
+  ## test rmd
+  rmd_deps <- detect_dependencies(test_path("test_inputs/deps_using_rmd.Rmd"))
+
+  expect_equal(
+    rmd_deps$package,
+    c("qfes", "ffdi", "datapasta", "slippymath", "rdeck"))
+
+  expect_equal(
+    rmd_deps$min_version,
+    c("0.2.1", "0.1.3", NA, "0.1.0", "0.2.5"))
+
+  expect_equal(
+    rmd_deps$repo,
+    c("https://github.com/qfes/qfes.git",
+      "https://[email protected]/qfes/packages/_git/ffdi",
+      "https://github.com/milesmcbain/datapasta",
+      NA,
+      "https://github.com/anthonynorth/rdeck"))
+
+  ## test R
+  r_deps <- detect_dependencies(test_path("test_inputs/deps_using.R"))
+
+  expect_equal(
+    r_deps$package,
+    c("qfes", "ffdi"))
+
+  ## test dupes
+  dupe_deps <- detect_dependencies(test_path("test_inputs/deps_using_dupes.R"))
+
+  expect_equal(
+    dupe_deps$package,
+    c("qfes", "ffdi", "rdeck", "ffdi", "rdeck"))
+
+
+  ## test none
+  none_deps <- detect_dependencies(test_path("test_inputs/deps_vanilla.R"))
+
+  expect_true(nrow(none_deps) == 0)
+  expect_equal(names(none_deps),
+               c("package", "min_version", "repo"))
+
+  ## test parse fail
+  expect_error(detect_dependencies(test_path("test_inputs/deps_parse_fail.R")),
+               "Could not detect usage of using::pkg in due to invalid R code.")
+
+  ## test unsupported file
+  expect_error(detect_dependencies(test_path("test_inputs/deps_md.md")),
+               "detect_dependencies only supported for .R and .Rmd")
+
+  ## test only 1 file path supported
+  expect_error(detect_dependencies(c(test_path("test_inputs/deps_using.R"),
+                                     "test_inputs/deps_parse_fail.R")),
+               "file_path must be single file path not a vector of length > 1")
+
+  ## test file not found
+  expect_error(detect_dependencies(test_path("test_inputs/does_not_exist.R")),
+               "could not find file")
+
+})

tests/testthat/test_inputs/deps_md.md

@@ -0,0 +1,8 @@
+using::pkg(qfes, min_version = "0.2.1", repo = "https://github.com/qfes/qfes.git")
+using::pkg(ffdi, min_version = "0.1.3", repo = "https://[email protected]/qfes/packages/_git/ffdi")
+using::pkg(datapasta, repo = "https://github.com/milesmcbain/datapasta")
+withr::with_libpaths(new = "foo/path",
+                     code = using::pkg(slippymath, min_version = "0.1.0"))
+library(geosphere) # to get the distance between stations
+library(concaveman)
+library(english)

tests/testthat/test_inputs/deps_parse_fail.R

@@ -0,0 +1,5 @@
+using(qfes min_version = "0.2.1", repo = "https://github.com/qfes/qfes.git")
+using(ffdi, min_version = "0.1.3", repo = "https://[email protected]/qfes/packages/_git/ffdi")
+library(geosphere) # to get the distance between stations
+library(concaveman)
+library(english)

tests/testthat/test_inputs/deps_using.R

@@ -0,0 +1,5 @@
+using::pkg(qfes, min_version = "0.2.1", repo = "https://github.com/qfes/qfes.git")
+using::pkg(ffdi, min_version = "0.1.3", repo = "https://[email protected]/qfes/packages/_git/ffdi")
+library(geosphere) # to get the distance between stations
+library(concaveman)
+library(english)

tests/testthat/test_inputs/deps_using_dupes.R

@@ -0,0 +1,12 @@
+using::pkg(qfes, min_version = "0.2.1", repo = "https://github.com/qfes/qfes.git")
+using::pkg(ffdi, min_version = "0.1.3", repo = "https://[email protected]/qfes/packages/_git/ffdi")
+using::pkg(rdeck, min_version = "0.2.3", repo = "https://github.com/anthonynorth/rdeck.git")
+
+## as above genuine dupe
+using::pkg(qfes, min_version = "0.2.1", repo = "https://github.com/qfes/qfes.git")
+
+## different version
+using::pkg(ffdi, min_version = "0.1.4", repo = "https://[email protected]/qfes/packages/_git/ffdi")
+
+## different repo
+using::pkg(rdeck, min_version = "0.2.3", repo = "c:/rdeck/")

tests/testthat/test_inputs/deps_using_rmd.Rmd

@@ -0,0 +1,41 @@
+---
+title: "Untitled Draft"
+author: "Report Author"
+date: "`r format(Sys.time(), '%d %B, %Y')`"
+output: html_document
+---
+
+```{r setup, include=FALSE}
+knitr::opts_chunk$set(echo = FALSE)
+```
+
+## Analysis
+
+```{r}
+using::pkg(qfes, min_version = "0.2.1", repo = "https://github.com/qfes/qfes.git")
+using::pkg(ffdi, min_version = "0.1.3", repo = "https://[email protected]/qfes/packages/_git/ffdi")
+using::pkg(datapasta, repo = "https://github.com/milesmcbain/datapasta")
+withr::with_libpaths(new = "foo/path",
+                     code = using::pkg(slippymath, min_version = "0.1.0"))
+library(geosphere) # to get the distance between stations
+library(concaveman)
+library(english)
+```
+
+
+`r using::pkg(rdeck, min_version = "0.2.5", repo = "https://github.com/anthonynorth/rdeck")`
+
+## Reproducibility
+
+<details><summary>Reproducibility receipt</summary>
+
+```{r}
+## datetime
+Sys.time()
+## repository
+git2r::repository()
+## session info
+sessionInfo(package = )
+```
+
+</details>

tests/testthat/test_inputs/deps_vanilla.R

@@ -0,0 +1,3 @@
+library(rmarkdown)
+library(here) # to get project root folder in Rmd
+library(knitr)