Merge branch 'dev' into 162_parse_log

NEWS.md

@@ -8,6 +8,7 @@
 - Add `read_log_file()` to read previous logrx log file as optional function
 - 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
 

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,

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
+
 }
 
 

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

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,

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

inst/WORDLIST

@@ -37,3 +37,4 @@ sessionInfo
 tidylog
 initialises
 scrollable
+knitr

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 <http://rmarkdown.rstudio.com>.
+
+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")`

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()
+})

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)
+
+})

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()

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.