From 237917e4bed6df95e047b9fe5db233149fcd22f0 Mon Sep 17 00:00:00 2001 From: Nicholas Masel Date: Tue, 25 Jul 2023 13:22:47 +0000 Subject: [PATCH 1/4] Closes #140 --- R/axecute.R | 7 +++++++ R/get.R | 24 +++++++++++++++++++-- R/interact.R | 15 +++++++++++++- R/log.R | 2 +- R/writer.R | 8 +++++-- man/axecute.Rd | 7 +++++++ tests/testthat/ref/ex1.Rmd | 31 ++++++++++++++++++++++++++++ tests/testthat/test-axecute.R | 39 +++++++++++++++++++++++++++++++++++ tests/testthat/test-get.R | 25 ++++++++++++++++++++++ tests/testthat/test-writer.R | 2 +- vignettes/approved.Rmd | 6 ++++++ 11 files changed, 159 insertions(+), 7 deletions(-) create mode 100644 tests/testthat/ref/ex1.Rmd diff --git a/R/axecute.R b/R/axecute.R index 9b52e75..f650eed 100644 --- a/R/axecute.R +++ b/R/axecute.R @@ -33,6 +33,13 @@ #' close(fileConn) #' #' axecute(file.path(dir, "hello.R")) +#' +#' +#' fileConn <- file(file.path(dir, "hello.Rmd")) +#' writeLines(text, fileConn) +#' close(fileConn) +#' +#' axecute(file.path(dir, "hello.Rmd")) axecute <- function(file, log_name = NA, log_path = NA, remove_log_object = TRUE, diff --git a/R/get.R b/R/get.R index 8c28f75..7422caa 100644 --- a/R/get.R +++ b/R/get.R @@ -155,6 +155,16 @@ get_masked_functions <- function(){ #' get_used_functions <- function(file){ + # if markdown, write R code, including inline, to a script + # use this script to find functions used + if (grepl("*.Rmd$", file, ignore.case = TRUE)){ + tmpfile <- tempfile(fileext = ".R") + on.exit(unlink(tmpfile)) + withr::local_options(list(knitr.purl.inline = TRUE)) + knitr::purl(file, tmpfile) + file <- tmpfile + } + # catch error retfun <- safely(parse, quiet = FALSE, @@ -191,14 +201,24 @@ get_used_functions <- function(file){ names_from = "token") %>% ungroup() - combine_tokens <- wide_tokens %>% + # if package is present, but symbol or special is not, a function did not follow the :: + # ex. knitr::opts_chunk$set() + # for this case, remove row that contains the package + # set will still be captured but we will be able to link it to a package in this current version + wide_tokens_wo_orphans <- wide_tokens[!(!is.na(wide_tokens$SYMBOL_PACKAGE) & is.na(wide_tokens$SYMBOL_FUNCTION_CALL) & is.na(wide_tokens$SPECIAL)),] + + combine_tokens <- wide_tokens_wo_orphans %>% mutate(function_name = coalesce(.data[["SYMBOL_FUNCTION_CALL"]], .data[["SPECIAL"]])) -get_library(combine_tokens) %>% + distinct_use <- get_library(combine_tokens) %>% select(all_of(c("function_name", "library"))) %>% distinct() + distinct_use[is.na(distinct_use)] <- "!!! NOT FOUND !!!" + + distinct_use + } diff --git a/R/interact.R b/R/interact.R index 959d052..703ed0c 100644 --- a/R/interact.R +++ b/R/interact.R @@ -110,6 +110,13 @@ set_log_name_path <- function(log_name = NA, log_path = NA) { #' @noRd run_safely <- function(file) "dummy" +#' Is this a R Markdown file +#' @param file String. Path to file to execute +#' @noRd +is_rmarkdown <- function(file) { + grepl("*.Rmd$", file, ignore.case = TRUE) +} + #' Dummy function for running a file #' @noRd run_file <- function(file){ @@ -118,7 +125,13 @@ run_file <- function(file){ } else{ exec_env <- getOption("log.rx.exec.env") } - source(file, local = exec_env) + + if(is_rmarkdown(file)){ + rmarkdown::render(file, envir = exec_env) + } else{ + source(file, local = exec_env) + } + } #' Safely run an R script and record results, outputs, messages, errors, warnings diff --git a/R/log.R b/R/log.R index ff80c3f..bc97905 100644 --- a/R/log.R +++ b/R/log.R @@ -279,7 +279,7 @@ log_write <- function(file = NA, } if ("result" %in% to_report){ cleaned_log_vec <- c(cleaned_log_vec, - write_result()) + write_result(file)) } cleaned_log_vec <- c(cleaned_log_vec, diff --git a/R/writer.R b/R/writer.R index b114546..579f871 100644 --- a/R/writer.R +++ b/R/writer.R @@ -260,10 +260,14 @@ write_output <- function() { #' #' @noRd #' -write_result <- function() { +write_result <- function(file) { result <- get_log_element("result") - c("\nResult:", paste0("\t", capture.output(result$value))) + if (is_rmarkdown(file)) { + c("\nResult:", paste0("\t", capture.output(result))) + } else { + c("\nResult:", paste0("\t", capture.output(result$value))) + } } #' Format lint results for writing diff --git a/man/axecute.Rd b/man/axecute.Rd index 9784fd5..420cfb5 100644 --- a/man/axecute.Rd +++ b/man/axecute.Rd @@ -53,4 +53,11 @@ writeLines(text, fileConn) close(fileConn) axecute(file.path(dir, "hello.R")) + + +fileConn <- file(file.path(dir, "hello.Rmd")) +writeLines(text, fileConn) +close(fileConn) + +axecute(file.path(dir, "hello.Rmd")) } diff --git a/tests/testthat/ref/ex1.Rmd b/tests/testthat/ref/ex1.Rmd new file mode 100644 index 0000000..4385555 --- /dev/null +++ b/tests/testthat/ref/ex1.Rmd @@ -0,0 +1,31 @@ +--- +title: "ex1" +date: "2023-07-06" +--- + +## R Markdown + +This is an R Markdown document. Markdown is a simple formatting syntax for authoring HTML, PDF, and MS Word documents. For more details on using R Markdown see . + +When you click the **Knit** button a document will be generated that includes both content as well as the output of any embedded R code chunks within the document. You can embed an R code chunk like this: + +```{r cars} +library(dplyr) +summary(cars) +``` + +## Including Plots + +You can also embed plots, for example: + +```{r pressure, echo=FALSE} +plot(pressure) +``` + +Note that the `echo = FALSE` parameter was added to the code chunk to prevent printing of the R code that generated the plot. + +```{r} +mtcars %>% + dplyr::filter(mpg >= 20) +``` +Let's test some inline code with `r print("print")` diff --git a/tests/testthat/test-axecute.R b/tests/testthat/test-axecute.R index 60a6016..07da1c0 100644 --- a/tests/testthat/test-axecute.R +++ b/tests/testthat/test-axecute.R @@ -98,3 +98,42 @@ test_that("include_rds works to output log as rds", { rm(con, scriptPath, logDir, logRDS) log_remove() }) + +test_that("axecute will run a markdown file and create the necessary log", { + options("log.rx" = NULL) + + scriptPath <- test_path("ref", "ex1.Rmd") + logDir <- tempdir() + + # check no log is currently written out + expect_warning(expect_error(file(file.path(logDir, "rmd_log_out"), "r"), "cannot open the connection")) + + axecute(scriptPath, log_name = "rmd_log_out", log_path = logDir, remove_log_object = FALSE) + con <- file(file.path(logDir, "rmd_log_out"), "r") + flines <- readLines(con) + close(con) + + # check that the output file is populated + expect_gt(length(flines), 1) + # check all the elements are there + expect_true(grepl(paste(write_log_header("logrx Metadata"), collapse = ','), + paste(flines,collapse = ','))) + expect_true(grepl(paste(write_log_header("User and File Information"), collapse = ','), + paste(flines,collapse = ','))) + expect_true(grepl(paste(write_log_header("Session Information"), collapse = ','), + paste(flines,collapse = ','))) + expect_true(grepl(paste(write_log_header("Masked Functions"), collapse = ','), + paste(flines,collapse = ','))) + expect_true(grepl(paste(write_log_header("Program Run Time Information"), collapse = ','), + paste(flines,collapse = ','))) + expect_true(grepl(paste(write_log_header("Errors and Warnings"), collapse = ','), + paste(flines,collapse = ','))) + expect_true(grepl(paste(write_log_header("Messages, Output, and Result"), collapse = ','), + paste(flines,collapse = ','))) + expect_true(grepl(paste(write_log_header("Log Output File"), collapse = ','), + paste(flines,collapse = ','))) + + # remove all the stuff we added + rm(flines, con, scriptPath, logDir) + log_remove() +}) diff --git a/tests/testthat/test-get.R b/tests/testthat/test-get.R index ac09c5f..a456005 100644 --- a/tests/testthat/test-get.R +++ b/tests/testthat/test-get.R @@ -159,3 +159,28 @@ test_that("lint returns expected result when option is not set", { expect_identical(get_lint_results(filename), NULL) }) + +test_that("functions used are returned correctly for rmd files", { + filename <- test_path("ref", "ex1.Rmd") + + tmpfile <- tempfile(fileext = ".R") + + withr::local_options(list(knitr.purl.inline = TRUE)) + + knitr::purl(filename, tmpfile) + + source(tmpfile, local = TRUE) + + expected <- tibble::tribble( + ~function_name, ~library, + "library", "package:base", + "summary", "package:base", + "plot", "package:graphics", + "%>%", "package:dplyr", + "filter", "package:dplyr", + "print", "package:base" + ) + + expect_identical(get_used_functions(tmpfile), expected) + +}) diff --git a/tests/testthat/test-writer.R b/tests/testthat/test-writer.R index dcd6d98..2ff04e3 100644 --- a/tests/testthat/test-writer.R +++ b/tests/testthat/test-writer.R @@ -176,7 +176,7 @@ test_that("write_result will return a formatted log result element", { run_safely_loudly(fp) - expect_identical(write_result(), + expect_identical(write_result(fp), c("\nResult:", paste0("\t", capture.output(data.frame(test = c(8, 6, 7, 5, 3, 0, 9)))))) log_remove() diff --git a/vignettes/approved.Rmd b/vignettes/approved.Rmd index 087bd07..6cfe091 100644 --- a/vignettes/approved.Rmd +++ b/vignettes/approved.Rmd @@ -173,3 +173,9 @@ logrx::log_remove() unlink(dir, recursive = TRUE) ``` + +# A Few Words of Caution + +All packages should be attached at the top of the script to set a consistent `?base::searchpaths()` throughout the entire script. This will ensure the functions you use in your script are linked to the correct package. A lint feature is available to test your scripts follow this best practice. + +Some functions are stored within a list, for example `knitr::opts_chunck$get()` and `knitr::opts_current$get()`. We do not currently identify `get()` as a knitr function since it is not exported. From c3f3b1402ac4ebe528a6666ec6d38ac165f765ed Mon Sep 17 00:00:00 2001 From: Ben Straub Date: Fri, 8 Sep 2023 15:12:39 -0400 Subject: [PATCH 2/4] Update NEWS.md --- NEWS.md | 1 + 1 file changed, 1 insertion(+) diff --git a/NEWS.md b/NEWS.md index 04ab86b..01867d8 100644 --- a/NEWS.md +++ b/NEWS.md @@ -6,6 +6,7 @@ - Add `include_rds` argument to `axecute()` to export log as rds file - Add `library_call_linter()` to ensure all library calls are at the top of the script (#163) - Remove argument for remove_log_object from `axecute()` still accessible via `log_write()` (#182) +- Added functionality so `axecute()` works with `.Rmd` files (#140) # logrx 0.2.2 From 863bce1678e58f315456d90891be26f7083f5b1a Mon Sep 17 00:00:00 2001 From: Ben Straub Date: Fri, 8 Sep 2023 15:52:50 -0400 Subject: [PATCH 3/4] Update test-axecute.R --- tests/testthat/test-axecute.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/tests/testthat/test-axecute.R b/tests/testthat/test-axecute.R index 5d443c7..39e6d41 100644 --- a/tests/testthat/test-axecute.R +++ b/tests/testthat/test-axecute.R @@ -145,7 +145,7 @@ test_that("axecute will run a markdown file and create the necessary log", { # check no log is currently written out expect_warning(expect_error(file(file.path(logDir, "rmd_log_out"), "r"), "cannot open the connection")) - axecute(scriptPath, log_name = "rmd_log_out", log_path = logDir, remove_log_object = FALSE) + axecute(scriptPath, log_name = "rmd_log_out", log_path = logDir) con <- file(file.path(logDir, "rmd_log_out"), "r") flines <- readLines(con) close(con) From a6ea3c3ddc8f0f27937b1e1a7d1ef83faa758f0a Mon Sep 17 00:00:00 2001 From: Ben Straub Date: Wed, 13 Sep 2023 15:10:02 -0400 Subject: [PATCH 4/4] Update WORDLIST --- inst/WORDLIST | 1 + 1 file changed, 1 insertion(+) diff --git a/inst/WORDLIST b/inst/WORDLIST index eaa54d7..cdd5bf7 100644 --- a/inst/WORDLIST +++ b/inst/WORDLIST @@ -37,3 +37,4 @@ sessionInfo tidylog initialises scrollable +knitr