diff --git a/NEWS.md b/NEWS.md index 2dd6732..a954efe 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 diff --git a/R/axecute.R b/R/axecute.R index 0b2091a..62a18cd 100644 --- a/R/axecute.R +++ b/R/axecute.R @@ -34,6 +34,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, include_rds = FALSE, diff --git a/R/get.R b/R/get.R index dd7dcfd..6f72922 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 cf812e7..59779c6 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 ec88d1b..99fbdf4 100644 --- a/R/log.R +++ b/R/log.R @@ -291,7 +291,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 43e9d96..986c04a 100644 --- a/R/writer.R +++ b/R/writer.R @@ -282,10 +282,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/inst/WORDLIST b/inst/WORDLIST index eaa54d7..cdd5bf7 100644 --- a/inst/WORDLIST +++ b/inst/WORDLIST @@ -37,3 +37,4 @@ sessionInfo tidylog initialises scrollable +knitr diff --git a/man/axecute.Rd b/man/axecute.Rd index 1a3d1cc..b16b955 100644 --- a/man/axecute.Rd +++ b/man/axecute.Rd @@ -56,4 +56,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 782de7d..39e6d41 100644 --- a/tests/testthat/test-axecute.R +++ b/tests/testthat/test-axecute.R @@ -135,3 +135,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) + 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 d792223..f7e186d 100644 --- a/tests/testthat/test-get.R +++ b/tests/testthat/test-get.R @@ -198,3 +198,28 @@ test_that("lint returns expected result when option is set to FALSE", { 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 d664089..c90dc1e 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 3751205..dc64c5a 100644 --- a/vignettes/approved.Rmd +++ b/vignettes/approved.Rmd @@ -176,3 +176,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.