From 2bdfdae761ea245b55b03252970b06d95a7238d5 Mon Sep 17 00:00:00 2001 From: Sam Parmar <107635309+parmsam-pfizer@users.noreply.github.com> Date: Tue, 14 Feb 2023 14:06:42 -0600 Subject: [PATCH 01/99] add rds saving option --- R/log.R | 13 ++++++++++--- 1 file changed, 10 insertions(+), 3 deletions(-) diff --git a/R/log.R b/R/log.R index 7e10223..2c6fb58 100644 --- a/R/log.R +++ b/R/log.R @@ -284,9 +284,16 @@ log_write <- function(file = NA, write_log_element("log_name", "Log name: "), write_log_element("log_path", "Log path: ")) - writeLines(cleaned_log_vec, - con = file.path(get_log_element("log_path"), - get_log_element("log_name"))) + if (tools::file_ext(get_log_element("log_name")) %in% c("log", "txt")){ + writeLines(cleaned_log_vec, + con = file.path(get_log_element("log_path"), + get_log_element("log_name"))) + } else if ( tolower(tools::file_ext(get_log_element("log_name"))) == "rds") { + saveRDS(cleaned_log_vec, + file = file.path(get_log_element("log_path"), + get_log_element("log_name"))) + } + if (remove_log_object) { log_remove() } From 055c7413b04cf4b4f33dda0649e11d32dfe453b2 Mon Sep 17 00:00:00 2001 From: Sam Parmar <107635309+parmsam-pfizer@users.noreply.github.com> Date: Tue, 14 Feb 2023 16:37:42 -0600 Subject: [PATCH 02/99] add arg to include nested Rds export --- R/log.R | 21 +++++++++++++++------ 1 file changed, 15 insertions(+), 6 deletions(-) diff --git a/R/log.R b/R/log.R index 2c6fb58..5e0b194 100644 --- a/R/log.R +++ b/R/log.R @@ -177,6 +177,7 @@ log_cleanup <- function() { #' log_write(file) log_write <- function(file = NA, remove_log_object = TRUE, + include_rds = TRUE, to_report = c("messages", "output", "result")){ # Set end time and run time set_log_element("end_time", strftime(Sys.time(), usetz = TRUE)) @@ -284,14 +285,22 @@ log_write <- function(file = NA, write_log_element("log_name", "Log name: "), write_log_element("log_path", "Log path: ")) - if (tools::file_ext(get_log_element("log_name")) %in% c("log", "txt")){ - writeLines(cleaned_log_vec, + writeLines(cleaned_log_vec, con = file.path(get_log_element("log_path"), get_log_element("log_name"))) - } else if ( tolower(tools::file_ext(get_log_element("log_name"))) == "rds") { - saveRDS(cleaned_log_vec, - file = file.path(get_log_element("log_path"), - get_log_element("log_name"))) + if (include_rds) { + cleaned_log_list <- lapply( + getOption('log.rx'), + function(i) i + ) + saveRDS(cleaned_log_list, + file = file.path( + get_log_element("log_path"), + paste0(tools::file_path_sans_ext( + get_log_element("log_name") + ),".Rds") + ) + ) } if (remove_log_object) { From 29867bb7cd3446e04510ad9087522421ad1ec80a Mon Sep 17 00:00:00 2001 From: Sam Parmar <107635309+parmsam-pfizer@users.noreply.github.com> Date: Tue, 14 Feb 2023 16:46:38 -0600 Subject: [PATCH 03/99] update session_info element in log_list to original output --- R/log.R | 1 + 1 file changed, 1 insertion(+) diff --git a/R/log.R b/R/log.R index 5e0b194..44f60e9 100644 --- a/R/log.R +++ b/R/log.R @@ -293,6 +293,7 @@ log_write <- function(file = NA, getOption('log.rx'), function(i) i ) + cleaned_log_list$session_info <- session_info(info = "all") saveRDS(cleaned_log_list, file = file.path( get_log_element("log_path"), From fe6c61cd857610d1ed8286d88f7873a1dc2c691b Mon Sep 17 00:00:00 2001 From: Sam Parmar <107635309+parmsam-pfizer@users.noreply.github.com> Date: Tue, 14 Feb 2023 16:55:18 -0600 Subject: [PATCH 04/99] fix roxygen and update documentation --- R/log.R | 3 ++- man/log_write.Rd | 3 +++ 2 files changed, 5 insertions(+), 1 deletion(-) diff --git a/R/log.R b/R/log.R index 44f60e9..4d80fd2 100644 --- a/R/log.R +++ b/R/log.R @@ -150,6 +150,7 @@ log_cleanup <- function() { #' to a log file #' #' @param file String. Path to file executed +#' @param include_rds Boolean. Option to export log object as Rds file #' @param remove_log_object Boolean. Should the log object be removed after #' writing the log file? Defaults to TRUE #' @param to_report String vector. Objects to optionally report; additional @@ -177,7 +178,7 @@ log_cleanup <- function() { #' log_write(file) log_write <- function(file = NA, remove_log_object = TRUE, - include_rds = TRUE, + include_rds = FALSE, to_report = c("messages", "output", "result")){ # Set end time and run time set_log_element("end_time", strftime(Sys.time(), usetz = TRUE)) diff --git a/man/log_write.Rd b/man/log_write.Rd index d269420..b535c8f 100644 --- a/man/log_write.Rd +++ b/man/log_write.Rd @@ -7,6 +7,7 @@ log_write( file = NA, remove_log_object = TRUE, + include_rds = FALSE, to_report = c("messages", "output", "result") ) } @@ -16,6 +17,8 @@ log_write( \item{remove_log_object}{Boolean. Should the log object be removed after writing the log file? Defaults to TRUE} +\item{include_rds}{Boolean. Option to export log object as Rds file} + \item{to_report}{String vector. Objects to optionally report; additional information in \code{\link{axecute}}} } From 8ac8cb4044a055f0721e6a1ec73731dbebc7d419 Mon Sep 17 00:00:00 2001 From: Sam Parmar <107635309+parmsam-pfizer@users.noreply.github.com> Date: Wed, 15 Feb 2023 10:41:29 -0600 Subject: [PATCH 05/99] filter rds fields based on log_cleanup() and to_report --- R/log.R | 23 +++++++++++++++++++---- 1 file changed, 19 insertions(+), 4 deletions(-) diff --git a/R/log.R b/R/log.R index 4d80fd2..3b6b7f1 100644 --- a/R/log.R +++ b/R/log.R @@ -289,10 +289,25 @@ log_write <- function(file = NA, writeLines(cleaned_log_vec, con = file.path(get_log_element("log_path"), get_log_element("log_name"))) - if (include_rds) { - cleaned_log_list <- lapply( - getOption('log.rx'), - function(i) i + if (include_rds){ + rds_fields <- c( + "end_time", "start_time", "run_time", "user", "hash_sum", + "log_path", "log_name", "file_path", "file_name", + "unapproved_packages_functions", "errors", "warnings" + ) + log_options <- as.list(getOption('log.rx')) + cleaned_log_list <- Map( + function(i, x){ + if(x %in% c("messages", "output", "result")){ + if(x %in% to_report){ + return(i) + } + } else if(x %in% c(names(log_cleanup()), rds_fields)){ + return(i) + } + }, + log_options, + names(log_options) ) cleaned_log_list$session_info <- session_info(info = "all") saveRDS(cleaned_log_list, From 8f7f9bc40ce6ca1380e83a3b8642e76f8df52e9e Mon Sep 17 00:00:00 2001 From: Sam Parmar <107635309+parmsam-pfizer@users.noreply.github.com> Date: Wed, 15 Feb 2023 12:34:44 -0600 Subject: [PATCH 06/99] add unit test for include_rds --- tests/testthat/test-axecute.R | 32 ++++++++++++++++++++++++++++++++ 1 file changed, 32 insertions(+) diff --git a/tests/testthat/test-axecute.R b/tests/testthat/test-axecute.R index 8f2dca2..60a6016 100644 --- a/tests/testthat/test-axecute.R +++ b/tests/testthat/test-axecute.R @@ -66,3 +66,35 @@ test_that("to_report works to control log output elements", { rm(flines, con, scriptPath, logDir) log_remove() }) + +test_that("include_rds works to output log as rds", { + options("log.rx" = NULL) + scriptPath <- tempfile() + logDir <- tempdir() + writeLines( + c("message('hello logrx')", + "cat('this is output')", + "data.frame(c(8, 6, 7, 5, 3, 0, 9))"), + con = scriptPath) + + # check no log is currently written out + expect_warning(expect_error(file(file.path(logDir, "log_out_nested"), "r"), "cannot open the connection")) + + axecute(scriptPath, + log_name = "log_out_nested", + log_path = logDir, + remove_log_object = FALSE, + include_rds = TRUE, + to_report = c("messages", "result")) + con <- file(file.path(logDir, "log_out_nested.Rds"), "r") + logRDS <- readRDS(file.path(logDir, "log_out_nested.Rds")) + + expect_type(logRDS, "list") + expect_true("messages" %in% names(logRDS)) + expect_true(all(is.na(logRDS$output))) + expect_true("result" %in% names(logRDS)) + expect_true("start_time" %in% names(logRDS)) + + rm(con, scriptPath, logDir, logRDS) + log_remove() +}) From 2bf9ed8fdf6a459594938d960b678a29afc6548b Mon Sep 17 00:00:00 2001 From: Sam Parmar <107635309+parmsam-pfizer@users.noreply.github.com> Date: Wed, 15 Feb 2023 12:42:56 -0600 Subject: [PATCH 07/99] add include_rds arg to axecute and update doc --- R/axecute.R | 8 +++++++- R/log.R | 3 ++- man/axecute.Rd | 4 ++++ man/log_write.Rd | 3 ++- 4 files changed, 15 insertions(+), 3 deletions(-) diff --git a/R/axecute.R b/R/axecute.R index 7af7930..9b52e75 100644 --- a/R/axecute.R +++ b/R/axecute.R @@ -10,6 +10,8 @@ #' @param log_path String. Path to log file #' @param remove_log_object Boolean. Should the log object be removed after #' writing the log file? Defaults to TRUE +#' @param include_rds Boolean. Option to export log object as Rds file. +#' Defaults to FALSE #' @param quit_on_error Boolean. Should the session quit with status 1 on error? #' Defaults to TRUE #' @param to_report String vector. Objects to optionally report, may include as @@ -34,6 +36,7 @@ axecute <- function(file, log_name = NA, log_path = NA, remove_log_object = TRUE, + include_rds = FALSE, quit_on_error = TRUE, to_report = c("messages", "output", "result")){ @@ -51,7 +54,10 @@ axecute <- function(file, log_name = NA, any_errors <- get_log_element("errors") # write log - log_write(file = file, remove_log_object = remove_log_object, to_report = to_report) + log_write(file = file, + remove_log_object = remove_log_object, + include_rds = include_rds, + to_report = to_report) # if error, quit with status = 1 if not interactive if(!interactive() & !is.null(any_errors) & quit_on_error) { diff --git a/R/log.R b/R/log.R index 3b6b7f1..25bf1d5 100644 --- a/R/log.R +++ b/R/log.R @@ -150,7 +150,8 @@ log_cleanup <- function() { #' to a log file #' #' @param file String. Path to file executed -#' @param include_rds Boolean. Option to export log object as Rds file +#' @param include_rds Boolean. Option to export log object as Rds file. +#' Defaults to TRUE #' @param remove_log_object Boolean. Should the log object be removed after #' writing the log file? Defaults to TRUE #' @param to_report String vector. Objects to optionally report; additional diff --git a/man/axecute.Rd b/man/axecute.Rd index 89e8e67..9784fd5 100644 --- a/man/axecute.Rd +++ b/man/axecute.Rd @@ -9,6 +9,7 @@ axecute( log_name = NA, log_path = NA, remove_log_object = TRUE, + include_rds = FALSE, quit_on_error = TRUE, to_report = c("messages", "output", "result") ) @@ -23,6 +24,9 @@ axecute( \item{remove_log_object}{Boolean. Should the log object be removed after writing the log file? Defaults to TRUE} +\item{include_rds}{Boolean. Option to export log object as Rds file. +Defaults to FALSE} + \item{quit_on_error}{Boolean. Should the session quit with status 1 on error? Defaults to TRUE} diff --git a/man/log_write.Rd b/man/log_write.Rd index b535c8f..db67039 100644 --- a/man/log_write.Rd +++ b/man/log_write.Rd @@ -17,7 +17,8 @@ log_write( \item{remove_log_object}{Boolean. Should the log object be removed after writing the log file? Defaults to TRUE} -\item{include_rds}{Boolean. Option to export log object as Rds file} +\item{include_rds}{Boolean. Option to export log object as Rds file. +Defaults to TRUE} \item{to_report}{String vector. Objects to optionally report; additional information in \code{\link{axecute}}} From 317f9ce347c5590707e746e45f4e2efe88901879 Mon Sep 17 00:00:00 2001 From: Sam Parmar <107635309+parmsam-pfizer@users.noreply.github.com> Date: Wed, 15 Feb 2023 12:58:28 -0600 Subject: [PATCH 08/99] update newsmd --- NEWS.md | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/NEWS.md b/NEWS.md index 46a8d26..c116ddf 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,3 +1,7 @@ +# logrx 0.2.2 + +- Add `include_rds` argument to `axecute()` to export log as rds file + # logrx 0.2.1 - non-function objects are no longer returned as functions by `get_used_functions` (#154) From 18ed207c89e2533c2ec6c82b4e78f4196b74807c Mon Sep 17 00:00:00 2001 From: Nicholas Masel Date: Wed, 15 Feb 2023 23:58:35 +0000 Subject: [PATCH 09/99] rmarkdown renders, functions mostly capture, only errors get logged --- R/get.R | 13 ++++++++++++- R/interact.R | 15 ++++++++++++++- R/log.R | 2 +- R/writer.R | 9 +++++++-- tests/testthat/test-writer.R | 2 +- 5 files changed, 35 insertions(+), 6 deletions(-) diff --git a/R/get.R b/R/get.R index 9870557..f10907c 100644 --- a/R/get.R +++ b/R/get.R @@ -155,6 +155,13 @@ get_masked_functions <- function(){ #' get_used_functions <- function(file){ + if (grepl("*.Rmd$", file, ignore.case = TRUE)){ + tmpfile <- tempfile(fileext = ".R") + on.exit(unlink(tmpfile)) + knitr::purl(file, tmpfile) + file <- tmpfile + } + # catch error retfun <- safely(parse, quiet = FALSE, @@ -194,10 +201,14 @@ get_used_functions <- function(file){ combine_tokens <- wide_tokens %>% mutate(function_name = coalesce(.data$SYMBOL_FUNCTION_CALL, .data$SPECIAL)) - get_library(combine_tokens) %>% + distinct_use <- get_library(combine_tokens) %>% select(.data$function_name, .data$library) %>% distinct(across()) + distinct_use[is.na(distinct_use)] <- "!!! NOT FOUND !!!" + + distinct_use + } diff --git a/R/interact.R b/R/interact.R index 959d052..5852004 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 7e10223..b420b73 100644 --- a/R/log.R +++ b/R/log.R @@ -276,7 +276,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 f10ac82..2b5268b 100644 --- a/R/writer.R +++ b/R/writer.R @@ -255,14 +255,19 @@ write_output <- function() { #' Format result attribute for writing #' +#' @param file String. Path to file to execute #' @return A formatted vector of results #' #' @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/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() From 5fa319fc8575d115d2bb8df9b52cf381099709d9 Mon Sep 17 00:00:00 2001 From: Sam Parmar <107635309+parmsam-pfizer@users.noreply.github.com> Date: Tue, 21 Feb 2023 15:48:28 -0600 Subject: [PATCH 10/99] update include_rds roxygen2 default --- R/log.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/log.R b/R/log.R index 25bf1d5..89b5d84 100644 --- a/R/log.R +++ b/R/log.R @@ -151,7 +151,7 @@ log_cleanup <- function() { #' #' @param file String. Path to file executed #' @param include_rds Boolean. Option to export log object as Rds file. -#' Defaults to TRUE +#' Defaults to FALSE #' @param remove_log_object Boolean. Should the log object be removed after #' writing the log file? Defaults to TRUE #' @param to_report String vector. Objects to optionally report; additional From 80152b4806bef80e380ca0d67b408c2758fff372 Mon Sep 17 00:00:00 2001 From: Sam Parmar <107635309+parmsam-pfizer@users.noreply.github.com> Date: Tue, 21 Feb 2023 15:59:56 -0600 Subject: [PATCH 11/99] use purrr::map2 instead of Map --- R/log.R | 8 ++++---- man/log_write.Rd | 2 +- 2 files changed, 5 insertions(+), 5 deletions(-) diff --git a/R/log.R b/R/log.R index 89b5d84..863d500 100644 --- a/R/log.R +++ b/R/log.R @@ -297,7 +297,9 @@ log_write <- function(file = NA, "unapproved_packages_functions", "errors", "warnings" ) log_options <- as.list(getOption('log.rx')) - cleaned_log_list <- Map( + cleaned_log_list <- purrr::map2( + log_options, + names(log_options), function(i, x){ if(x %in% c("messages", "output", "result")){ if(x %in% to_report){ @@ -306,9 +308,7 @@ log_write <- function(file = NA, } else if(x %in% c(names(log_cleanup()), rds_fields)){ return(i) } - }, - log_options, - names(log_options) + } ) cleaned_log_list$session_info <- session_info(info = "all") saveRDS(cleaned_log_list, diff --git a/man/log_write.Rd b/man/log_write.Rd index db67039..aa4f657 100644 --- a/man/log_write.Rd +++ b/man/log_write.Rd @@ -18,7 +18,7 @@ log_write( writing the log file? Defaults to TRUE} \item{include_rds}{Boolean. Option to export log object as Rds file. -Defaults to TRUE} +Defaults to FALSE} \item{to_report}{String vector. Objects to optionally report; additional information in \code{\link{axecute}}} From 971eca811a986e6b81ca0be2ba13f849abffe476 Mon Sep 17 00:00:00 2001 From: Sam Parmar <107635309+parmsam-pfizer@users.noreply.github.com> Date: Wed, 22 Feb 2023 12:28:17 -0600 Subject: [PATCH 12/99] add log reading functions --- R/read_log_file.R | 251 ++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 251 insertions(+) create mode 100644 R/read_log_file.R diff --git a/R/read_log_file.R b/R/read_log_file.R new file mode 100644 index 0000000..2b5aceb --- /dev/null +++ b/R/read_log_file.R @@ -0,0 +1,251 @@ +#' Reformat subsections in log lines +#' +#' @param log_txt vector object with log text lines +#' +#' @importFrom stringr str_detect +#' @importFrom stringr str_count +#' @importFrom stringr str_remove +#' +#' @return tibble that ensures formatted subsections +#' +#' @examples +#' \dontrun{ +#' reformat_subsections(readlines(log_file_path)) +#' } +#' +#' @noRd +#' +reformat_subsections <- function(log_txt) { + adj_log_txt <- c() + for (i in log_txt) { + adj_tf <- stringr::str_detect( + i, + "Errors:|Warnings:|Messages:|Output:|Result:" + ) + if (adj_tf) { + nrem <- stringr::str_count(i) + i <- stringr::str_remove(i, ":") + i <- + paste("-", i, paste(rep("-", 54 - nrem), collapse = ""), + collapse = "") + } + adj_log_txt <- c(adj_log_txt, i) + } + return(adj_log_txt) +} + +#' Nest sections in log lines vector +#' +#' @param adj_log_txt vector object with formatted log text lines +#' +#' @importFrom stringr str_remove_all +#' +#' @return list that includes nested log sections +#' +#' @noRd +#' +nest_sections <- function(adj_log_txt) { + sect_headers <- c() + sect_status <- FALSE + sect_info <- list() + for (i in adj_log_txt) { + if (i == paste(rep("-", 80), collapse = "")) { + sect_status <- !sect_status + } else if (sect_status == TRUE) { + sect_headers <- c(sect_headers, i) + } else { + cur_pos <- length(sect_headers) + if (length(sect_info) == cur_pos) { + sect_info[[cur_pos]] <- c(sect_info[[cur_pos]], i) + } else { + sect_info[[cur_pos]] <- i + } + } + } + sect_headers <- + stringr::str_remove_all(sect_headers, "-?\\s{3,}-?") + names(sect_info) <- sect_headers + + return(sect_info) +} + +#' Nest subsections in log lines vector +#' +#' @param adj_log_txt vector object with formatted log text lines +#' @param sect_info vector with nested sections (from `nest_sections()`) +#' +#' @importFrom stringr str_extract +#' @importFrom stringr str_trim +#' @importFrom stringr str_remove_all +#' +#' @return list that includes nested log subsections +#' +#' @noRd +#' +nest_subsections <- function(adj_log_txt, sect_info) { + subsect_headers <- na.omit( + stringr::str_extract(adj_log_txt, "\\-\\s\\w+\\s(\\w+\\s)?\\-{3,70}") + ) + subset_sections <- function(section) { + subsect_status <- FALSE + subsect_info <- list() + for (i in section) { + if (i %in% subsect_headers) { + latest_subsect <- stringr::str_trim( + stringr::str_remove_all(i, "\\-") + ) + subsect_status <- TRUE + } else if (subsect_status) { + subsect_info[[latest_subsect]] <- + c(subsect_info[[latest_subsect]], i) + } else { + subsect_info <- c(subsect_info, i) + } + } + subsect_info + } + nested_log <- lapply(sect_info, subset_sections) + return(nested_log) +} + +#' Nest sections and subsections in log lines vector +#' +#' @param adj_log_txt vector object with formatted log text lines +#' +#' @return list that includes nested log sections and subsections +#' +#' @noRd +#' +nest_log <- function(adj_log_txt) { + nest_subsections(adj_log_txt, + nest_sections(adj_log_txt)) +} + +#' Parse nested log list to tibbles for object where appropriate +#' +#' @param nested_log nested log output (from `nest_log()`) +#' +#' @importFrom tibble tibble +#' @importFrom tidyr separate +#' @importFrom stringr str_replace_all +#' @importFrom dplyr rename_with +#' @importFrom readr read_table +#' @importFrom dplyr mutate +#' +#' @return list with objects coerced as tibbles +#' +#' @noRd +#' +parse_log <- function(nested_log) { + parsed_log <- list() + + if ("logrx Metadata" %in% names(nested_log)) { + parsed_log$`logrx Metadata` <- + nested_log$`logrx Metadata` %>% + unlist() %>% + tibble::tibble() %>% + tidyr::separate(".", + sep = "\\: ", + into = c("Variable", "Value")) + } + + if ("User and File Information" %in% names(nested_log)) { + parsed_log$`User and File Information` <- + nested_log$`User and File Information` %>% + unlist() %>% + tibble::tibble() %>% + tidyr::separate(".", + sep = "\\: ", + into = c("Variable", "Value")) + } + + if ("Session Information" %in% names(nested_log)) { + parsed_log$`Session Information`$`Session info` <- + nested_log$`Session Information`$`Session info` %>% + readr::read_table() + + parsed_log$`Session Information`$`Packages` <- + nested_log$`Session Information`$`Packages` %>% + stringr::str_replace_all("\\*", " ") %>% + readr::read_table(skip = 1, col_names = FALSE) %>% + dplyr::rename_with(~ c( + "package", + "version", + "date", + "lib", + "source", + "lang", + "r_version" + )) %>% + dplyr::mutate( + lang = stringr::str_remove(lang, "\\("), + r_version = stringr::str_remove(r_version, "\\)") + ) + + parsed_log$`Session Information`$`External software` <- + nested_log$`Session Information`$`External software` %>% + readr::read_table() + } + + if ("Masked Functions" %in% names(nested_log)) { + parsed_log$`Masked Functions` <- + nested_log$`Masked Functions` %>% + unlist() %>% + tibble::tibble("Masked Functions" = .) + + } + + if ("Used Package and Functions" %in% names(nested_log)) { + parsed_log$`Used Package and Functions` <- + nested_log$`Used Package and Functions` %>% + unlist() %>% + tibble::tibble() %>% + tidyr::separate(".", + sep = "\\} ", + into = c("library", "function_names")) %>% + dplyr::mutate(library = stringr::str_remove(library, "\\{")) + } + + if ("Program Run Time Information" %in% names(nested_log)) { + parsed_log$`Program Run Time Information` <- + nested_log$`Program Run Time Information` %>% + unlist() %>% + tibble::tibble() %>% + tidyr::separate(".", + sep = "\\: ", + into = c("Variable", "Value")) + } + + if ("Log Output File" %in% names(nested_log)) { + parsed_log$`Log Output File` <- + nested_log$`Log Output File` %>% + unlist() %>% + tibble::tibble() %>% + tidyr::separate(".", + sep = "\\: ", + into = c("Variable", "Value")) + } + + return(parsed_log) +} + +#' Read and parse previous logrx file +#' +#' @param file character path to a logrx file +#' +#' @return tibble that includes nested and parsed content +#' +#' @examples +#' \dontrun{ +#' read_log_file(previous_log_filepath) +#' } +#' +#' @noRd +#' +read_log_file <- function(file) { + parsed_log <- readLines(file) %>% + reformat_subsections() %>% + nest_log() %>% + parse_log() + return(parsed_log) +} From 8dccc88caee2bb2f943dfaf19d04f44c346c05f3 Mon Sep 17 00:00:00 2001 From: Sam Parmar <107635309+parmsam-pfizer@users.noreply.github.com> Date: Mon, 27 Feb 2023 14:56:25 -0600 Subject: [PATCH 13/99] Move the capture output to the write function --- R/get.R | 2 +- R/log.R | 4 ++-- R/writer.R | 1 + 3 files changed, 4 insertions(+), 3 deletions(-) diff --git a/R/get.R b/R/get.R index 9870557..728fc52 100644 --- a/R/get.R +++ b/R/get.R @@ -96,7 +96,7 @@ get_file_path <- function(file = NA, normalize = TRUE){ #' @noRd #' get_session_info <- function(){ - return(capture.output(session_info(info = "all"))) + return(session_info(info = "all")) } diff --git a/R/log.R b/R/log.R index 863d500..ff80c3f 100644 --- a/R/log.R +++ b/R/log.R @@ -294,7 +294,8 @@ log_write <- function(file = NA, rds_fields <- c( "end_time", "start_time", "run_time", "user", "hash_sum", "log_path", "log_name", "file_path", "file_name", - "unapproved_packages_functions", "errors", "warnings" + "unapproved_packages_functions", "errors", "warnings", + "session_info" ) log_options <- as.list(getOption('log.rx')) cleaned_log_list <- purrr::map2( @@ -310,7 +311,6 @@ log_write <- function(file = NA, } } ) - cleaned_log_list$session_info <- session_info(info = "all") saveRDS(cleaned_log_list, file = file.path( get_log_element("log_path"), diff --git a/R/writer.R b/R/writer.R index f10ac82..b114546 100644 --- a/R/writer.R +++ b/R/writer.R @@ -50,6 +50,7 @@ write_metadata <- function(){ #' write_session_info <- function(){ session_info <- get_log_element("session_info") %>% + capture.output() %>% # remove extra dashes on title lines map_chr(~ ifelse(nchar(.x) > 80 & grepl("\u2500\u2500\u2500\u2500", .x), substring(.x, 1, 80), From 03a516218fefe72564aa4a658db9695e5d7cdf07 Mon Sep 17 00:00:00 2001 From: Sam Parmar <107635309+parmsam-pfizer@users.noreply.github.com> Date: Mon, 27 Feb 2023 14:58:12 -0600 Subject: [PATCH 14/99] update session info capture test to capture.output of session info obj --- tests/testthat/test-get.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/tests/testthat/test-get.R b/tests/testthat/test-get.R index b477174..ac09c5f 100644 --- a/tests/testthat/test-get.R +++ b/tests/testthat/test-get.R @@ -22,7 +22,7 @@ test_that("when given a file as an argument a non-normalized file path to that f }) test_that("session info is captured", { - expect_identical(get_session_info(), capture.output(session_info(info = "all"))) + expect_identical(capture.output(get_session_info()), capture.output(session_info(info = "all"))) }) test_that("all functions that are masked are found and returned", { From 4c7b760dfbc9bd178089d6f6d69edcfd68795b42 Mon Sep 17 00:00:00 2001 From: Sam Parmar <107635309+parmsam-pfizer@users.noreply.github.com> Date: Wed, 1 Mar 2023 16:10:58 -0600 Subject: [PATCH 15/99] add readr to DESCRIPTION file --- DESCRIPTION | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/DESCRIPTION b/DESCRIPTION index 9eed103..0221fd3 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -50,7 +50,8 @@ Imports: waiter, tibble, digest, - lintr + lintr, + readr Suggests: testthat (>= 3.0.0), knitr, From f7684d38d38d0a56508a269f573fe90072c3c1e7 Mon Sep 17 00:00:00 2001 From: Sam Parmar <107635309+parmsam-pfizer@users.noreply.github.com> Date: Wed, 1 Mar 2023 16:11:47 -0600 Subject: [PATCH 16/99] update documentation and style for tidy --- NAMESPACE | 8 + R/read_log_file.R | 361 +++++++++++++++++++++++-------------------- man/read_log_file.Rd | 23 +++ 3 files changed, 228 insertions(+), 164 deletions(-) create mode 100644 man/read_log_file.Rd diff --git a/NAMESPACE b/NAMESPACE index bc32ecc..6ebcae0 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -16,6 +16,7 @@ importFrom(dplyr,distinct) importFrom(dplyr,filter) importFrom(dplyr,group_by) importFrom(dplyr,mutate) +importFrom(dplyr,rename_with) importFrom(dplyr,select) importFrom(dplyr,ungroup) importFrom(lintr,lint) @@ -32,6 +33,7 @@ importFrom(purrr,map2_dfr) importFrom(purrr,map_chr) importFrom(purrr,safely) importFrom(purrr,set_names) +importFrom(readr,read_table) importFrom(rlang,.data) importFrom(rstudioapi,selectDirectory) importFrom(rstudioapi,selectFile) @@ -52,13 +54,19 @@ importFrom(shiny,uiOutput) importFrom(stats,aggregate) importFrom(stringi,stri_wrap) importFrom(stringr,str_c) +importFrom(stringr,str_count) +importFrom(stringr,str_detect) +importFrom(stringr,str_extract) +importFrom(stringr,str_remove) importFrom(stringr,str_remove_all) importFrom(stringr,str_replace) importFrom(stringr,str_replace_all) importFrom(stringr,str_starts) +importFrom(stringr,str_trim) importFrom(tibble,tibble) importFrom(tidyr,complete) importFrom(tidyr,pivot_wider) +importFrom(tidyr,separate) importFrom(utils,capture.output) importFrom(utils,getParseData) importFrom(utils,lsf.str) diff --git a/R/read_log_file.R b/R/read_log_file.R index 2b5aceb..0fa2810 100644 --- a/R/read_log_file.R +++ b/R/read_log_file.R @@ -1,6 +1,6 @@ #' Reformat subsections in log lines #' -#' @param log_txt vector object with log text lines +#' @param log_txt String vector. Object with log text lines #' #' @importFrom stringr str_detect #' @importFrom stringr str_count @@ -16,27 +16,28 @@ #' @noRd #' reformat_subsections <- function(log_txt) { - adj_log_txt <- c() - for (i in log_txt) { - adj_tf <- stringr::str_detect( - i, - "Errors:|Warnings:|Messages:|Output:|Result:" - ) - if (adj_tf) { - nrem <- stringr::str_count(i) - i <- stringr::str_remove(i, ":") - i <- - paste("-", i, paste(rep("-", 54 - nrem), collapse = ""), - collapse = "") - } - adj_log_txt <- c(adj_log_txt, i) - } - return(adj_log_txt) + adj_log_txt <- c() + for (i in log_txt) { + adj_tf <- stringr::str_detect( + i, + "Errors:|Warnings:|Messages:|Output:|Result:" + ) + if (adj_tf) { + nrem <- stringr::str_count(i) + i <- stringr::str_remove(i, ":") + i <- + paste("-", i, paste(rep("-", 54 - nrem), collapse = ""), + collapse = "" + ) + } + adj_log_txt <- c(adj_log_txt, i) + } + return(adj_log_txt) } #' Nest sections in log lines vector #' -#' @param adj_log_txt vector object with formatted log text lines +#' @param adj_log_txt String vector. Object with formatted log text lines #' #' @importFrom stringr str_remove_all #' @@ -45,34 +46,34 @@ reformat_subsections <- function(log_txt) { #' @noRd #' nest_sections <- function(adj_log_txt) { - sect_headers <- c() - sect_status <- FALSE - sect_info <- list() - for (i in adj_log_txt) { - if (i == paste(rep("-", 80), collapse = "")) { - sect_status <- !sect_status - } else if (sect_status == TRUE) { - sect_headers <- c(sect_headers, i) + sect_headers <- c() + sect_status <- FALSE + sect_info <- list() + for (i in adj_log_txt) { + if (i == paste(rep("-", 80), collapse = "")) { + sect_status <- !sect_status + } else if (sect_status == TRUE) { + sect_headers <- c(sect_headers, i) + } else { + cur_pos <- length(sect_headers) + if (length(sect_info) == cur_pos) { + sect_info[[cur_pos]] <- c(sect_info[[cur_pos]], i) } else { - cur_pos <- length(sect_headers) - if (length(sect_info) == cur_pos) { - sect_info[[cur_pos]] <- c(sect_info[[cur_pos]], i) - } else { - sect_info[[cur_pos]] <- i - } + sect_info[[cur_pos]] <- i } - } - sect_headers <- - stringr::str_remove_all(sect_headers, "-?\\s{3,}-?") - names(sect_info) <- sect_headers + } + } + sect_headers <- + stringr::str_remove_all(sect_headers, "-?\\s{3,}-?") + names(sect_info) <- sect_headers - return(sect_info) + return(sect_info) } #' Nest subsections in log lines vector #' -#' @param adj_log_txt vector object with formatted log text lines -#' @param sect_info vector with nested sections (from `nest_sections()`) +#' @param adj_log_txt String vector. Object with formatted log text lines +#' @param sect_info String vector. Object with nested sections #' #' @importFrom stringr str_extract #' @importFrom stringr str_trim @@ -83,47 +84,50 @@ nest_sections <- function(adj_log_txt) { #' @noRd #' nest_subsections <- function(adj_log_txt, sect_info) { - subsect_headers <- na.omit( - stringr::str_extract(adj_log_txt, "\\-\\s\\w+\\s(\\w+\\s)?\\-{3,70}") - ) - subset_sections <- function(section) { - subsect_status <- FALSE - subsect_info <- list() - for (i in section) { - if (i %in% subsect_headers) { - latest_subsect <- stringr::str_trim( - stringr::str_remove_all(i, "\\-") - ) - subsect_status <- TRUE - } else if (subsect_status) { - subsect_info[[latest_subsect]] <- - c(subsect_info[[latest_subsect]], i) - } else { - subsect_info <- c(subsect_info, i) - } + subsect_headers <- na.omit( + stringr::str_extract(adj_log_txt, "\\-\\s\\w+\\s(\\w+\\s)?\\-{3,70}") + ) + subset_sections <- function(section) { + subsect_status <- FALSE + subsect_info <- list() + for (i in section) { + if (i %in% subsect_headers) { + latest_subsect <- stringr::str_trim( + stringr::str_remove_all(i, "\\-") + ) + subsect_status <- TRUE + } else if (subsect_status) { + subsect_info[[latest_subsect]] <- + c(subsect_info[[latest_subsect]], i) + } else { + subsect_info <- c(subsect_info, i) } - subsect_info - } - nested_log <- lapply(sect_info, subset_sections) - return(nested_log) + } + subsect_info + } + nested_log <- lapply(sect_info, subset_sections) + return(nested_log) } #' Nest sections and subsections in log lines vector #' -#' @param adj_log_txt vector object with formatted log text lines +#' @param adj_log_txt String vector. Object with formatted log text lines #' #' @return list that includes nested log sections and subsections #' #' @noRd #' nest_log <- function(adj_log_txt) { - nest_subsections(adj_log_txt, - nest_sections(adj_log_txt)) + nest_subsections( + adj_log_txt, + nest_sections(adj_log_txt) + ) } #' Parse nested log list to tibbles for object where appropriate #' -#' @param nested_log nested log output (from `nest_log()`) +#' @param nested_log String vector. +#' Object with nested log output (from `nest_log()`) #' #' @importFrom tibble tibble #' @importFrom tidyr separate @@ -137,115 +141,144 @@ nest_log <- function(adj_log_txt) { #' @noRd #' parse_log <- function(nested_log) { - parsed_log <- list() - - if ("logrx Metadata" %in% names(nested_log)) { - parsed_log$`logrx Metadata` <- - nested_log$`logrx Metadata` %>% - unlist() %>% - tibble::tibble() %>% - tidyr::separate(".", - sep = "\\: ", - into = c("Variable", "Value")) - } - - if ("User and File Information" %in% names(nested_log)) { - parsed_log$`User and File Information` <- - nested_log$`User and File Information` %>% - unlist() %>% - tibble::tibble() %>% - tidyr::separate(".", - sep = "\\: ", - into = c("Variable", "Value")) - } - - if ("Session Information" %in% names(nested_log)) { - parsed_log$`Session Information`$`Session info` <- - nested_log$`Session Information`$`Session info` %>% - readr::read_table() - - parsed_log$`Session Information`$`Packages` <- - nested_log$`Session Information`$`Packages` %>% - stringr::str_replace_all("\\*", " ") %>% - readr::read_table(skip = 1, col_names = FALSE) %>% - dplyr::rename_with(~ c( - "package", - "version", - "date", - "lib", - "source", - "lang", - "r_version" - )) %>% - dplyr::mutate( - lang = stringr::str_remove(lang, "\\("), - r_version = stringr::str_remove(r_version, "\\)") - ) - - parsed_log$`Session Information`$`External software` <- - nested_log$`Session Information`$`External software` %>% - readr::read_table() - } - - if ("Masked Functions" %in% names(nested_log)) { - parsed_log$`Masked Functions` <- - nested_log$`Masked Functions` %>% - unlist() %>% - tibble::tibble("Masked Functions" = .) - - } - - if ("Used Package and Functions" %in% names(nested_log)) { - parsed_log$`Used Package and Functions` <- - nested_log$`Used Package and Functions` %>% - unlist() %>% - tibble::tibble() %>% - tidyr::separate(".", - sep = "\\} ", - into = c("library", "function_names")) %>% - dplyr::mutate(library = stringr::str_remove(library, "\\{")) - } - - if ("Program Run Time Information" %in% names(nested_log)) { - parsed_log$`Program Run Time Information` <- - nested_log$`Program Run Time Information` %>% - unlist() %>% - tibble::tibble() %>% - tidyr::separate(".", - sep = "\\: ", - into = c("Variable", "Value")) - } - - if ("Log Output File" %in% names(nested_log)) { - parsed_log$`Log Output File` <- - nested_log$`Log Output File` %>% - unlist() %>% - tibble::tibble() %>% - tidyr::separate(".", - sep = "\\: ", - into = c("Variable", "Value")) - } - - return(parsed_log) + parsed_log <- list() + + if ("logrx Metadata" %in% names(nested_log)) { + parsed_log$`logrx Metadata` <- + nested_log$`logrx Metadata` %>% + unlist() %>% + tibble::tibble() %>% + tidyr::separate(".", + sep = "\\: ", + into = c("Variable", "Value"), + extra = "merge" + ) + } + + if ("User and File Information" %in% names(nested_log)) { + parsed_log$`User and File Information` <- + nested_log$`User and File Information` %>% + unlist() %>% + stringr::str_trim() %>% + tibble::tibble() %>% + tidyr::separate(".", + sep = "\\: ", + into = c("Variable", "Value") + ) + } + + if ("Session Information" %in% names(nested_log)) { + parsed_log$`Session Information`$`Session info` <- + nested_log$`Session Information`$`Session info` %>% + unlist() %>% + stringr::str_trim() %>% + tibble::tibble() %>% + tidyr::separate(".", + sep = "\\s", + into = c("setting", "value"), + extra = "merge", + ) %>% + mutate(across(is.character, stringr::str_trim)) + + parsed_log$`Session Information`$`Packages` <- + nested_log$`Session Information`$`Packages` %>% + # remove indicator whether the package is attached to the search path + stringr::str_replace_all("\\*", " ") %>% + # account for loaded packages due to load_all() + stringr::str_replace_all(" P ", " ") %>% + readr::read_table(skip = 1, col_names = FALSE) %>% + dplyr::rename_with(~ c( + "package", + "version", + "date", + "lib", + "source", + "lang", + "r_version" + )) %>% + dplyr::mutate( + lang = stringr::str_remove(lang, "\\("), + r_version = stringr::str_remove(r_version, "\\)") + ) + + parsed_log$`Session Information`$`External software` <- + nested_log$`Session Information`$`External software` %>% + stringr::str_trim() %>% + tibble::tibble() %>% + tidyr::separate(".", + sep = "\\s", + into = c("setting", "value"), + extra = "merge", + ) %>% + mutate(across(where(is.character), stringr::str_trim)) + } + + if ("Masked Functions" %in% names(nested_log)) { + parsed_log$`Masked Functions` <- + nested_log$`Masked Functions` %>% + unlist() %>% + tibble::tibble("Masked Functions" = .) + } + + if ("Used Package and Functions" %in% names(nested_log)) { + parsed_log$`Used Package and Functions` <- + nested_log$`Used Package and Functions` %>% + unlist() %>% + tibble::tibble() %>% + tidyr::separate(".", + sep = "\\} ", + into = c("library", "function_names") + ) %>% + dplyr::mutate(library = stringr::str_remove(library, "\\{")) + } + + if ("Program Run Time Information" %in% names(nested_log)) { + parsed_log$`Program Run Time Information` <- + nested_log$`Program Run Time Information` %>% + unlist() %>% + tibble::tibble() %>% + tidyr::separate(".", + sep = "\\: ", + into = c("Variable", "Value") + ) + } + + if ("Log Output File" %in% names(nested_log)) { + parsed_log$`Log Output File` <- + nested_log$`Log Output File` %>% + unlist() %>% + tibble::tibble() %>% + tidyr::separate(".", + sep = "\\: ", + into = c("Variable", "Value") + ) + } + + return(parsed_log) } #' Read and parse previous logrx file #' -#' @param file character path to a logrx file +#' @param file String. Path to a logrx log file #' -#' @return tibble that includes nested and parsed content +#' @return Tibble. Object that includes nested and parsed content #' #' @examples #' \dontrun{ #' read_log_file(previous_log_filepath) #' } #' -#' @noRd -#' read_log_file <- function(file) { - parsed_log <- readLines(file) %>% - reformat_subsections() %>% - nest_log() %>% - parse_log() - return(parsed_log) + if (!file.exists(file)) { + stop("Path does not exist:", sQuote(file)) + } + con <- file(file.path(file), "r") + flines <- readLines(con) + close(con) + + parsed_log <- flines %>% + reformat_subsections() %>% + nest_log() %>% + parse_log() + return(parsed_log) } diff --git a/man/read_log_file.Rd b/man/read_log_file.Rd new file mode 100644 index 0000000..5c66c7e --- /dev/null +++ b/man/read_log_file.Rd @@ -0,0 +1,23 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/read_log_file.R +\name{read_log_file} +\alias{read_log_file} +\title{Read and parse previous logrx file} +\usage{ +read_log_file(file) +} +\arguments{ +\item{file}{String. Path to a logrx log file} +} +\value{ +Tibble. Object that includes nested and parsed content +} +\description{ +Read and parse previous logrx file +} +\examples{ +\dontrun{ +read_log_file(previous_log_filepath) +} + +} From 8d79eec8fd17459601c74aa84c3c87668c12fe9b Mon Sep 17 00:00:00 2001 From: Sam Parmar <107635309+parmsam-pfizer@users.noreply.github.com> Date: Wed, 1 Mar 2023 16:12:00 -0600 Subject: [PATCH 17/99] add unit test --- tests/testthat/test-parse.R | 44 +++++++++++++++++++++++++++++++++++++ 1 file changed, 44 insertions(+) create mode 100644 tests/testthat/test-parse.R diff --git a/tests/testthat/test-parse.R b/tests/testthat/test-parse.R new file mode 100644 index 0000000..5781566 --- /dev/null +++ b/tests/testthat/test-parse.R @@ -0,0 +1,44 @@ +test_that("read_log_file will parse a logrx log file and create the necessary object", { + options("log.rx" = NULL) + scriptPath <- tempfile() + logDir <- tempdir() + writeLines("print('hello logrx')", con = scriptPath) + + # check no log is currently written out + filePath <- file.path(logDir, "log_out_parse") + expect_warning(expect_error(file(filePath, "r"), "cannot open the connection")) + + axecute(scriptPath, log_name = "log_out_parse", log_path = logDir, remove_log_object = FALSE) + + # check that the log file can be parsed + parsedFile <- read_log_file(filePath) + + expect_length(parsedFile, 7) + expect_named( + parsedFile, + c( + "logrx Metadata", + "User and File Information", + "Session Information", + "Masked Functions", + "Used Package and Functions", + "Program Run Time Information", + "Log Output File" + ) + ) + expect_true(all(sapply( + parsedFile[names(parsedFile) != "Session Information"], + is.data.frame + ))) + + expect_true( + all(sapply( + parsedFile[names(parsedFile) != "Session Information"], + nrow + ) > 0) + ) + + # remove all the stuff we added + rm(scriptPath, logDir, parsedFile) + log_remove() +}) From 10d74dc16e606d2c61631b3eb04e9589b8716e31 Mon Sep 17 00:00:00 2001 From: Sam Parmar <107635309+parmsam-pfizer@users.noreply.github.com> Date: Wed, 1 Mar 2023 16:17:57 -0600 Subject: [PATCH 18/99] Update pkgdown site yml --- _pkgdown.yml | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/_pkgdown.yml b/_pkgdown.yml index 39a1662..46e76eb 100644 --- a/_pkgdown.yml +++ b/_pkgdown.yml @@ -22,6 +22,10 @@ reference: - write_log_header - write_unapproved_functions - write_used_functions +- title: Read Previous Log + desc: Functionality to Read Previous Log Files +- contents: + - read_log_file - title: Utilities desc: Utility functions - contents: From dd182811c2ea5dee56fe7aeb9194807403c22bcf Mon Sep 17 00:00:00 2001 From: Sam Parmar <107635309+parmsam-pfizer@users.noreply.github.com> Date: Wed, 1 Mar 2023 16:18:19 -0600 Subject: [PATCH 19/99] Update newsmd with new read_log_file --- NEWS.md | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/NEWS.md b/NEWS.md index 46a8d26..6132e52 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,3 +1,7 @@ +# logrx 0.2.2 + +- Add `read_log_file()` to read previous logrx log file + # logrx 0.2.1 - non-function objects are no longer returned as functions by `get_used_functions` (#154) From 4115c0d554e8201ca2e6462c20e6cd5583209c13 Mon Sep 17 00:00:00 2001 From: Sam Parmar <107635309+parmsam-pfizer@users.noreply.github.com> Date: Tue, 7 Mar 2023 14:25:44 -0500 Subject: [PATCH 20/99] add arg to capture repo urls and ensure unit tests --- R/axecute.R | 10 +++++++-- R/get.R | 12 ++++++++++ R/log.R | 16 +++++++++++-- R/writer.R | 22 ++++++++++++++++++ man/axecute.Rd | 6 ++++- man/log_write.Rd | 6 ++++- tests/testthat/test-axecute.R | 42 +++++++++++++++++++++++++++++++++++ tests/testthat/test-log.R | 2 +- 8 files changed, 109 insertions(+), 7 deletions(-) diff --git a/R/axecute.R b/R/axecute.R index 7af7930..3dd30cf 100644 --- a/R/axecute.R +++ b/R/axecute.R @@ -17,6 +17,8 @@ #' * messages: any messages generated by program execution #' * output: any output generated by program execution #' * result: any result generated by program execution +#' @param show_repo_url Boolean. Should the repo URLs be reported +#' Defaults to FALSE #' #' @importFrom purrr map_chr #' @@ -35,7 +37,8 @@ axecute <- function(file, log_name = NA, log_path = NA, remove_log_object = TRUE, quit_on_error = TRUE, - to_report = c("messages", "output", "result")){ + to_report = c("messages", "output", "result"), + show_repo_url = FALSE){ # lower everything for consistency and check values to_report <- map_chr(to_report, tolower) @@ -51,7 +54,10 @@ axecute <- function(file, log_name = NA, any_errors <- get_log_element("errors") # write log - log_write(file = file, remove_log_object = remove_log_object, to_report = to_report) + log_write(file = file, + remove_log_object = remove_log_object, + to_report = to_report, + show_repo_url = show_repo_url) # if error, quit with status = 1 if not interactive if(!interactive() & !is.null(any_errors) & quit_on_error) { diff --git a/R/get.R b/R/get.R index 9870557..442ba0e 100644 --- a/R/get.R +++ b/R/get.R @@ -289,3 +289,15 @@ get_lint_results <- function(file) { lint(file, getOption('log.rx.lint')) } } + +#' Get repository URLs +#' +#' Obtain repository URLs possibly used to install packages in session +#' +#' @return results from `getOption("repos")` as list +#' +#' @noRd +#' +get_repo_urls <- function() { + as.list(getOption("repos")) +} diff --git a/R/log.R b/R/log.R index 7e10223..5322618 100644 --- a/R/log.R +++ b/R/log.R @@ -83,7 +83,8 @@ log_config <- function(file = NA, log_name = NA, log_path = NA){ "unapproved_packages_functions", "lint_results", "log_name", - "log_path") + "log_path", + "repo_urls") # Add attributes to the log.rx environment, and set them to NA for (key in 1:length(keys)){ @@ -108,6 +109,8 @@ log_config <- function(file = NA, log_name = NA, log_path = NA){ set_log_name_path(log_name, log_path) # lint results set_log_element("lint_results", get_lint_results(file)) + # repo urls + set_log_element("repo_urls", get_repo_urls()) } #' Cleaning-up of log.rx object @@ -154,6 +157,8 @@ log_cleanup <- function() { #' writing the log file? Defaults to TRUE #' @param to_report String vector. Objects to optionally report; additional #' information in \code{\link{axecute}} +#' @param show_repo_url Boolean. Should the repo URLs be reported +#' Defaults to FALSE #' #' @return Nothing #' @export @@ -177,7 +182,8 @@ log_cleanup <- function() { #' log_write(file) log_write <- function(file = NA, remove_log_object = TRUE, - to_report = c("messages", "output", "result")){ + to_report = c("messages", "output", "result"), + show_repo_url = FALSE){ # Set end time and run time set_log_element("end_time", strftime(Sys.time(), usetz = TRUE)) set_log_element("run_time", @@ -210,6 +216,12 @@ log_write <- function(file = NA, write_log_header("Session Information"), write_session_info()) + if (show_repo_url) { + cleaned_log_vec <- c(cleaned_log_vec, + write_log_header("Repo URLs"), + write_repo_urls()) + } + if ("masked_functions" %in% names(log_cleanup())) { cleaned_log_vec <- c(cleaned_log_vec, write_log_header("Masked Functions"), diff --git a/R/writer.R b/R/writer.R index f10ac82..4bde2f2 100644 --- a/R/writer.R +++ b/R/writer.R @@ -62,6 +62,28 @@ write_session_info <- function(){ return(session_info) } +#' Format repo URLs for writing +#' +#' @return A vector of file name and path prefixed +#' +#' @noRd +#' +write_repo_urls <- function(){ + repo_urls <- ifelse(is.na(get_log_element("repo_urls")), + "Repo URLs not able to be determined", + map2( + names(get_log_element("repo_urls")), + get_log_element("repo_urls"), + ~paste(paste0(.x, ": "), + paste0(.y, collapse = ", ")) + ) %>% + unname() %>% + unlist() + ) + + return(repo_urls) +} + #' Format file name and path for writing #' #' @return A vector of file name and path prefixed diff --git a/man/axecute.Rd b/man/axecute.Rd index 89e8e67..8a385c5 100644 --- a/man/axecute.Rd +++ b/man/axecute.Rd @@ -10,7 +10,8 @@ axecute( log_path = NA, remove_log_object = TRUE, quit_on_error = TRUE, - to_report = c("messages", "output", "result") + to_report = c("messages", "output", "result"), + show_repo_url = FALSE ) } \arguments{ @@ -33,6 +34,9 @@ many as necessary: \item output: any output generated by program execution \item result: any result generated by program execution }} + +\item{show_repo_url}{Boolean. Should the repo URLs be reported +Defaults to FALSE} } \value{ 0 if there are no errors or 1 if there are any errors diff --git a/man/log_write.Rd b/man/log_write.Rd index d269420..4ea1713 100644 --- a/man/log_write.Rd +++ b/man/log_write.Rd @@ -7,7 +7,8 @@ log_write( file = NA, remove_log_object = TRUE, - to_report = c("messages", "output", "result") + to_report = c("messages", "output", "result"), + show_repo_url = FALSE ) } \arguments{ @@ -18,6 +19,9 @@ writing the log file? Defaults to TRUE} \item{to_report}{String vector. Objects to optionally report; additional information in \code{\link{axecute}}} + +\item{show_repo_url}{Boolean. Should the repo URLs be reported +Defaults to FALSE} } \value{ Nothing diff --git a/tests/testthat/test-axecute.R b/tests/testthat/test-axecute.R index 8f2dca2..932e01e 100644 --- a/tests/testthat/test-axecute.R +++ b/tests/testthat/test-axecute.R @@ -66,3 +66,45 @@ test_that("to_report works to control log output elements", { rm(flines, con, scriptPath, logDir) log_remove() }) + +test_that("show_repo_url works to show repo url elements", { + options("log.rx" = NULL) + scriptPath <- tempfile() + logDir <- tempdir() + writeLines( + c("message('hello logrx')", + "cat('this is output')", + "data.frame(c(8, 6, 7, 5, 3, 0, 9))"), + con = scriptPath) + + # check no log is currently written out + expect_warning(expect_error(file(file.path(logDir, "log_out_repo_url"), "r"), "cannot open the connection")) + + axecute(scriptPath, log_name = "log_out_repo_url", + log_path = logDir, + remove_log_object = FALSE, + show_repo_url = TRUE + ) + con <- file(file.path(logDir, "log_out_repo_url"), "r") + flines <- readLines(con) + close(con) + + expect_true(grepl(paste(write_log_header("Repo URLs"), collapse = ','), + paste(flines,collapse = ','))) + rm(flines, con) + log_remove() + + axecute(scriptPath, log_name = "log_out_repo_url2", + log_path = logDir, + remove_log_object = FALSE, + show_repo_url = FALSE + ) + con <- file(file.path(logDir, "log_out_repo_url2"), "r") + flines <- readLines(con) + close(con) + + expect_false(grepl(paste(write_log_header("Repo URLs"), collapse = ','), + paste(flines,collapse = ','))) + rm(flines, con, scriptPath, logDir) + log_remove() +}) diff --git a/tests/testthat/test-log.R b/tests/testthat/test-log.R index d8ab347..e26338e 100644 --- a/tests/testthat/test-log.R +++ b/tests/testthat/test-log.R @@ -13,7 +13,7 @@ test_that("log_config configures the log and all the necessary elements", { "result","output","start_time", "end_time", "run_time", "file_name","file_path","user", "hash_sum", "masked_functions", "used_packages_functions", "unapproved_packages_functions", - "lint_results", "log_name","log_path")) + "lint_results", "log_name","log_path", "repo_urls")) expect_identical(getOption("log.rx")[['file_path']], dirname(get_file_path('./test-get.R'))) expect_identical(getOption("log.rx")[['file_name']], basename(get_file_path('./test-get.R'))) From 7c4785a336c401f9f462d36784d4af4a90a6f96d Mon Sep 17 00:00:00 2001 From: Sam Parmar <107635309+parmsam-pfizer@users.noreply.github.com> Date: Tue, 7 Mar 2023 14:35:41 -0500 Subject: [PATCH 21/99] update news md --- NEWS.md | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/NEWS.md b/NEWS.md index 46a8d26..745b583 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,3 +1,7 @@ +# logrx 0.2.2 + +- Add `show_repo_url` option in `axecute()` to capture repo URL(s) into log file + # logrx 0.2.1 - non-function objects are no longer returned as functions by `get_used_functions` (#154) From 1c63ea3a0b724ac3056f8173630dc3f076a5c678 Mon Sep 17 00:00:00 2001 From: Sam Parmar <107635309+parmsam-pfizer@users.noreply.github.com> Date: Tue, 7 Mar 2023 15:07:20 -0500 Subject: [PATCH 22/99] Wrap predicate function in `where()` --- R/read_log_file.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/read_log_file.R b/R/read_log_file.R index 0fa2810..77705cd 100644 --- a/R/read_log_file.R +++ b/R/read_log_file.R @@ -178,7 +178,7 @@ parse_log <- function(nested_log) { into = c("setting", "value"), extra = "merge", ) %>% - mutate(across(is.character, stringr::str_trim)) + mutate(across(where(is.character), stringr::str_trim)) parsed_log$`Session Information`$`Packages` <- nested_log$`Session Information`$`Packages` %>% From 6b86210bd77fb7f136b017a81021eb20d0d692a4 Mon Sep 17 00:00:00 2001 From: Sam Parmar <107635309+parmsam-pfizer@users.noreply.github.com> Date: Tue, 14 Mar 2023 10:10:56 -0400 Subject: [PATCH 23/99] default parsed log to already nested log --- R/read_log_file.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/read_log_file.R b/R/read_log_file.R index 0fa2810..4a3a629 100644 --- a/R/read_log_file.R +++ b/R/read_log_file.R @@ -141,7 +141,7 @@ nest_log <- function(adj_log_txt) { #' @noRd #' parse_log <- function(nested_log) { - parsed_log <- list() + parsed_log <- nested_log if ("logrx Metadata" %in% names(nested_log)) { parsed_log$`logrx Metadata` <- From 221a2ed632eacf2de6db3d7e3bffa61e2a39d0d7 Mon Sep 17 00:00:00 2001 From: Ben Straub Date: Thu, 29 Jun 2023 15:51:00 +0000 Subject: [PATCH 24/99] feat: #179 bootstrap 5 --- DESCRIPTION | 2 +- NEWS.md | 4 ++++ _pkgdown.yml | 17 +++++++++++++++-- 3 files changed, 20 insertions(+), 3 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index 4a5b802..dda1046 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,6 +1,6 @@ Package: logrx Title: A Logging Utility Focus on Clinical Trial Programming Workflows -Version: 0.2.2 +Version: 0.3.0 Authors@R: c( person(given = "Nathan", diff --git a/NEWS.md b/NEWS.md index c8d7428..1bc8b07 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,3 +1,7 @@ +# logrx 0.3.0 + +- Moved website theme to bootstarp 5, enabled search (#179) + # logrx 0.2.2 - Hotfix to remove unnecessary `across()` and update `.data$var` top new syntax to match updates in source packages (#172) diff --git a/_pkgdown.yml b/_pkgdown.yml index 39a1662..e9bc99b 100644 --- a/_pkgdown.yml +++ b/_pkgdown.yml @@ -1,9 +1,22 @@ -destination: docs +url: https://pharmaverse.github.io/logrx/ template: + bootstrap: 5 params: - bootswatch: yeti + bootswatch: sandstone +search: + exclude: ["news/index.html"] +news: + cran_dates: true +navbar: + structure: + right: [slack, github] + components: + slack: + icon: fa-slack + href: https://pharmaverse.slack.com + aria-label: slack reference: - title: Source a file with Logging desc: Functionality for Creating logs from Scripts From c51a73620b9c0140ea75f1c2a6875173b5de291e Mon Sep 17 00:00:00 2001 From: Ben Straub Date: Thu, 29 Jun 2023 11:59:25 -0400 Subject: [PATCH 25/99] fix: #179 comment out mac rcmd check --- .github/workflows/check-standard.yaml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.github/workflows/check-standard.yaml b/.github/workflows/check-standard.yaml index e604aee..99bd0b9 100644 --- a/.github/workflows/check-standard.yaml +++ b/.github/workflows/check-standard.yaml @@ -23,7 +23,7 @@ jobs: matrix: config: - {os: windows-latest, r: 'release'} - - {os: macOS-latest, r: 'release'} + #- {os: macOS-latest, r: 'release'} - {os: ubuntu-20.04, r: '3.5', repos: "https://packagemanager.rstudio.com/cran/__linux__/focal/latest"} - {os: ubuntu-20.04, r: '3.6', repos: "https://packagemanager.rstudio.com/cran/__linux__/focal/latest"} - {os: ubuntu-20.04, r: 'release', rspm: "https://packagemanager.rstudio.com/cran/__linux__/focal/latest"} From 858ff84c697be0115be78745afb793019c485bc3 Mon Sep 17 00:00:00 2001 From: Nicholas Masel Date: Mon, 3 Jul 2023 13:33:22 +0000 Subject: [PATCH 26/99] resolve conflict --- R/get.R | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) diff --git a/R/get.R b/R/get.R index f10907c..d9c525c 100644 --- a/R/get.R +++ b/R/get.R @@ -201,13 +201,13 @@ get_used_functions <- function(file){ combine_tokens <- wide_tokens %>% mutate(function_name = coalesce(.data$SYMBOL_FUNCTION_CALL, .data$SPECIAL)) - distinct_use <- get_library(combine_tokens) %>% - select(.data$function_name, .data$library) %>% - distinct(across()) + get_library(combine_tokens) %>% + select(all_of(c("function_name", "library"))) %>% + distinct() - distinct_use[is.na(distinct_use)] <- "!!! NOT FOUND !!!" - - distinct_use + # distinct_use[is.na(distinct_use)] <- "!!! NOT FOUND !!!" + # + # distinct_use } From ce6a9d0cd55dbf282ff50c8245bff19ee0deeb06 Mon Sep 17 00:00:00 2001 From: Nicholas Masel Date: Mon, 3 Jul 2023 13:38:41 +0000 Subject: [PATCH 27/99] resolve conflict --- R/get.R | 4 ---- 1 file changed, 4 deletions(-) diff --git a/R/get.R b/R/get.R index d9c525c..fbd118e 100644 --- a/R/get.R +++ b/R/get.R @@ -205,10 +205,6 @@ get_used_functions <- function(file){ select(all_of(c("function_name", "library"))) %>% distinct() - # distinct_use[is.na(distinct_use)] <- "!!! NOT FOUND !!!" - # - # distinct_use - } From 96d90a7563513ac2c559225c039126dd67df546b Mon Sep 17 00:00:00 2001 From: Ben Straub Date: Mon, 3 Jul 2023 16:24:24 +0000 Subject: [PATCH 28/99] Revert "Merge branch '140-feature-request-create-unit-test-for-rmd-files' into dev" This reverts commit df6eb4d49a25346774152a5a47d08a6cc98360e2, reversing changes made to 9ae9814fbd9a4d11d167ceb6a0b06ce30e804c7e. --- R/get.R | 7 ------- R/interact.R | 15 +-------------- R/log.R | 2 +- R/writer.R | 9 ++------- tests/testthat/test-writer.R | 2 +- 5 files changed, 5 insertions(+), 30 deletions(-) diff --git a/R/get.R b/R/get.R index 4ab8830..92f4ec7 100644 --- a/R/get.R +++ b/R/get.R @@ -155,13 +155,6 @@ get_masked_functions <- function(){ #' get_used_functions <- function(file){ - if (grepl("*.Rmd$", file, ignore.case = TRUE)){ - tmpfile <- tempfile(fileext = ".R") - on.exit(unlink(tmpfile)) - knitr::purl(file, tmpfile) - file <- tmpfile - } - # catch error retfun <- safely(parse, quiet = FALSE, diff --git a/R/interact.R b/R/interact.R index 5852004..959d052 100644 --- a/R/interact.R +++ b/R/interact.R @@ -110,13 +110,6 @@ 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){ @@ -125,13 +118,7 @@ run_file <- function(file){ } else{ exec_env <- getOption("log.rx.exec.env") } - - if (is_rmarkdown(file)) { - rmarkdown::render(file, envir = exec_env) - } else ( - source(file, local = exec_env) - ) - + 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 b420b73..7e10223 100644 --- a/R/log.R +++ b/R/log.R @@ -276,7 +276,7 @@ log_write <- function(file = NA, } if ("result" %in% to_report){ cleaned_log_vec <- c(cleaned_log_vec, - write_result(file)) + write_result()) } cleaned_log_vec <- c(cleaned_log_vec, diff --git a/R/writer.R b/R/writer.R index 2b5268b..f10ac82 100644 --- a/R/writer.R +++ b/R/writer.R @@ -255,19 +255,14 @@ write_output <- function() { #' Format result attribute for writing #' -#' @param file String. Path to file to execute #' @return A formatted vector of results #' #' @noRd #' -write_result <- function(file) { +write_result <- function() { result <- get_log_element("result") - if (is_rmarkdown(file)) { - c("\nResult:", paste0("\t", capture.output(result))) - } else { - c("\nResult:", paste0("\t", capture.output(result$value))) - } + c("\nResult:", paste0("\t", capture.output(result$value))) } #' Format lint results for writing diff --git a/tests/testthat/test-writer.R b/tests/testthat/test-writer.R index 2ff04e3..dcd6d98 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(fp), + expect_identical(write_result(), c("\nResult:", paste0("\t", capture.output(data.frame(test = c(8, 6, 7, 5, 3, 0, 9)))))) log_remove() From b47c7d31404eae8b9f326480dfe04180993d5861 Mon Sep 17 00:00:00 2001 From: Ben Straub Date: Mon, 3 Jul 2023 16:26:33 +0000 Subject: [PATCH 29/99] Revert "resolve conflict" This reverts commit ce6a9d0cd55dbf282ff50c8245bff19ee0deeb06. --- R/get.R | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/R/get.R b/R/get.R index 92f4ec7..4a79b03 100644 --- a/R/get.R +++ b/R/get.R @@ -199,6 +199,10 @@ get_used_functions <- function(file){ select(all_of(c("function_name", "library"))) %>% distinct() + # distinct_use[is.na(distinct_use)] <- "!!! NOT FOUND !!!" + # + # distinct_use + } From 6afe6c4c6e5739ea3d3b7acc381f78576bdb696b Mon Sep 17 00:00:00 2001 From: Ben Straub Date: Mon, 3 Jul 2023 16:26:43 +0000 Subject: [PATCH 30/99] Revert "resolve conflict" This reverts commit 858ff84c697be0115be78745afb793019c485bc3. --- R/get.R | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) diff --git a/R/get.R b/R/get.R index 4a79b03..385eb0e 100644 --- a/R/get.R +++ b/R/get.R @@ -195,13 +195,13 @@ get_used_functions <- function(file){ mutate(function_name = coalesce(.data[["SYMBOL_FUNCTION_CALL"]], .data[["SPECIAL"]])) - get_library(combine_tokens) %>% - select(all_of(c("function_name", "library"))) %>% - distinct() + distinct_use <- get_library(combine_tokens) %>% + select(.data$function_name, .data$library) %>% + distinct(across()) - # distinct_use[is.na(distinct_use)] <- "!!! NOT FOUND !!!" - # - # distinct_use + distinct_use[is.na(distinct_use)] <- "!!! NOT FOUND !!!" + + distinct_use } From 582878cf6dd96304874f5148d74626fc2f1d46f1 Mon Sep 17 00:00:00 2001 From: Ben Straub Date: Thu, 6 Jul 2023 12:04:01 -0400 Subject: [PATCH 31/99] Update R/get.R Co-authored-by: Nicholas Masel <61123199+nicholas-masel@users.noreply.github.com> --- R/get.R | 10 +++------- 1 file changed, 3 insertions(+), 7 deletions(-) diff --git a/R/get.R b/R/get.R index 385eb0e..12d9884 100644 --- a/R/get.R +++ b/R/get.R @@ -195,13 +195,9 @@ get_used_functions <- function(file){ mutate(function_name = coalesce(.data[["SYMBOL_FUNCTION_CALL"]], .data[["SPECIAL"]])) - distinct_use <- get_library(combine_tokens) %>% - select(.data$function_name, .data$library) %>% - distinct(across()) - - distinct_use[is.na(distinct_use)] <- "!!! NOT FOUND !!!" - - distinct_use +get_library(combine_tokens) %>% + select(all_of(c("function_name", "library"))) %>% + distinct() } From 5379306a7f025d3423867eff97a7ea18e7bfbe3b Mon Sep 17 00:00:00 2001 From: Ben Straub Date: Thu, 6 Jul 2023 12:05:31 -0400 Subject: [PATCH 32/99] Update check-standard.yaml --- .github/workflows/check-standard.yaml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.github/workflows/check-standard.yaml b/.github/workflows/check-standard.yaml index 99bd0b9..e604aee 100644 --- a/.github/workflows/check-standard.yaml +++ b/.github/workflows/check-standard.yaml @@ -23,7 +23,7 @@ jobs: matrix: config: - {os: windows-latest, r: 'release'} - #- {os: macOS-latest, r: 'release'} + - {os: macOS-latest, r: 'release'} - {os: ubuntu-20.04, r: '3.5', repos: "https://packagemanager.rstudio.com/cran/__linux__/focal/latest"} - {os: ubuntu-20.04, r: '3.6', repos: "https://packagemanager.rstudio.com/cran/__linux__/focal/latest"} - {os: ubuntu-20.04, r: 'release', rspm: "https://packagemanager.rstudio.com/cran/__linux__/focal/latest"} From 30b28400e87ed7dd5f5628dbc168294473be8ffc Mon Sep 17 00:00:00 2001 From: ThomasP-B Date: Sun, 9 Jul 2023 18:46:04 +0100 Subject: [PATCH 33/99] Disable warning when text file is missing final EOL --- R/interact.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/interact.R b/R/interact.R index 959d052..cf812e7 100644 --- a/R/interact.R +++ b/R/interact.R @@ -139,7 +139,7 @@ run_safely_loudly <- function(file) { set_log_element("result", ret$result$result) set_log_element("warnings", ret$warnings) set_log_element("errors", ret$result$error) - set_log_element("hash_sum", digest::sha1(readLines(file))) + set_log_element("hash_sum", digest::sha1(readLines(file, warn = FALSE))) # Session Info set_log_element("session_info", get_session_info()) From bdd9d8d12d4c11a69f89f647d8c3e9c59e105298 Mon Sep 17 00:00:00 2001 From: ThomasP-B Date: Sun, 9 Jul 2023 18:47:06 +0100 Subject: [PATCH 34/99] Create spell check workflow --- .github/workflows/spellcheck.yaml | 25 +++++++++++++++++++++++++ 1 file changed, 25 insertions(+) create mode 100644 .github/workflows/spellcheck.yaml diff --git a/.github/workflows/spellcheck.yaml b/.github/workflows/spellcheck.yaml new file mode 100644 index 0000000..3928703 --- /dev/null +++ b/.github/workflows/spellcheck.yaml @@ -0,0 +1,25 @@ +--- +name: Spellcheck + +on: + push: + branches: + - main + - dev + pull_request: + branches: + - main + - dev + +jobs: + check: + runs-on: ubuntu-latest + name: Spellcheck + steps: + - name: Checkout repo + uses: actions/checkout@v3 + + - name: Run Spelling Check test + uses: insightsengineering/r-spellcheck-action@v3 + with: + exclude: data/* From 7cdac300793573a8ad9bad2469fd4126d68e86e5 Mon Sep 17 00:00:00 2001 From: Sam Parmar <107635309+parmsam-pfizer@users.noreply.github.com> Date: Mon, 10 Jul 2023 13:46:59 -0400 Subject: [PATCH 35/99] fix unit tests --- tests/testthat/test-axecute.R | 13 +++++++++++-- 1 file changed, 11 insertions(+), 2 deletions(-) diff --git a/tests/testthat/test-axecute.R b/tests/testthat/test-axecute.R index 99807fd..ac45188 100644 --- a/tests/testthat/test-axecute.R +++ b/tests/testthat/test-axecute.R @@ -68,7 +68,17 @@ test_that("to_report works to control log output elements", { }) test_that("show_repo_url works to show repo url elements", { - expect_warning(expect_error(file(file.path(logDir, "log_out_repo_url"), "r"), "cannot open the connection")) + options("log.rx" = NULL) + scriptPath <- tempfile() + logDir <- tempdir() + writeLines( + c("message('hello logrx')", + "cat('this is output')", + "data.frame(c(8, 6, 7, 5, 3, 0, 9))"), + con = scriptPath) + + # check no log is currently written out + expect_warning(expect_error(file(file.path(logDir, "log_out_repo_url"), "r"), "cannot open the connection")) axecute(scriptPath, log_name = "log_out_repo_url", log_path = logDir, @@ -99,7 +109,6 @@ test_that("show_repo_url works to show repo url elements", { }) test_that("include_rds works to output log as rds", { - options("log.rx" = NULL) scriptPath <- tempfile() logDir <- tempdir() From 3e0257f2127ec780bdac15b4628e901ca3eda43f Mon Sep 17 00:00:00 2001 From: Sam Parmar <107635309+parmsam-pfizer@users.noreply.github.com> Date: Mon, 10 Jul 2023 13:47:07 -0400 Subject: [PATCH 36/99] update doc --- man/log_write.Rd | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/man/log_write.Rd b/man/log_write.Rd index bff8a7b..906dc09 100644 --- a/man/log_write.Rd +++ b/man/log_write.Rd @@ -7,7 +7,7 @@ log_write( file = NA, remove_log_object = TRUE, - show_repo_url = FALSE + show_repo_url = FALSE, include_rds = FALSE, to_report = c("messages", "output", "result") ) @@ -18,14 +18,14 @@ log_write( \item{remove_log_object}{Boolean. Should the log object be removed after writing the log file? Defaults to TRUE} +\item{show_repo_url}{Boolean. Should the repo URLs be reported +Defaults to FALSE} + \item{include_rds}{Boolean. Option to export log object as Rds file. Defaults to FALSE} \item{to_report}{String vector. Objects to optionally report; additional information in \code{\link{axecute}}} - -\item{show_repo_url}{Boolean. Should the repo URLs be reported -Defaults to FALSE} } \value{ Nothing From c2b70d82cc0b4b42b83551b0151f56799b56720f Mon Sep 17 00:00:00 2001 From: Sam Parmar <107635309+parmsam-pfizer@users.noreply.github.com> Date: Wed, 12 Jul 2023 15:40:48 -0400 Subject: [PATCH 37/99] remove remove_log_object arg from axecute --- R/axecute.R | 6 +++--- R/logrxAddin.R | 8 +------- tests/testthat/test-axecute.R | 4 +--- vignettes/approved.Rmd | 2 +- 4 files changed, 6 insertions(+), 14 deletions(-) diff --git a/R/axecute.R b/R/axecute.R index 9b52e75..8578b6a 100644 --- a/R/axecute.R +++ b/R/axecute.R @@ -8,8 +8,6 @@ #' @param file String. Path to file to execute #' @param log_name String. Name of log file #' @param log_path String. Path to log file -#' @param remove_log_object Boolean. Should the log object be removed after -#' writing the log file? Defaults to TRUE #' @param include_rds Boolean. Option to export log object as Rds file. #' Defaults to FALSE #' @param quit_on_error Boolean. Should the session quit with status 1 on error? @@ -35,11 +33,13 @@ #' axecute(file.path(dir, "hello.R")) axecute <- function(file, log_name = NA, log_path = NA, - remove_log_object = TRUE, include_rds = FALSE, quit_on_error = TRUE, to_report = c("messages", "output", "result")){ + # remove log object + remove_log_object <- TRUE + # lower everything for consistency and check values to_report <- map_chr(to_report, tolower) match.arg(to_report, several.ok = TRUE) diff --git a/R/logrxAddin.R b/R/logrxAddin.R index 507ff08..1c7242b 100644 --- a/R/logrxAddin.R +++ b/R/logrxAddin.R @@ -88,12 +88,6 @@ logrxAddin <- function() { width = '100%') )), #User name check box - shiny::fluidRow( - shiny::column( - 12, - shiny::checkboxInput("rmLog", "Remove the log object after axecution?", TRUE) - ) - ), shiny::fluidRow( shiny::column( 12, @@ -167,7 +161,7 @@ logrxAddin <- function() { html = spin_solar() # use a spinner ) axecute(file = logInfo$file, log_name = logInfo$name, - log_path = logInfo$location, remove_log_object = input$rmLog, + log_path = logInfo$location, to_report = input$toReport) doneCheck$data <- "Select a new file, if you wish to run more files" waiter_hide() # hide the waiter diff --git a/tests/testthat/test-axecute.R b/tests/testthat/test-axecute.R index 60a6016..0908af0 100644 --- a/tests/testthat/test-axecute.R +++ b/tests/testthat/test-axecute.R @@ -7,7 +7,7 @@ test_that("axecute will run a file and create the necessary log", { # check no log is currently written out expect_warning(expect_error(file(file.path(logDir, "log_out"), "r"), "cannot open the connection")) - axecute(scriptPath, log_name = "log_out", log_path = logDir, remove_log_object = FALSE) + axecute(scriptPath, log_name = "log_out", log_path = logDir) con <- file(file.path(logDir, "log_out"), "r") flines <- readLines(con) close(con) @@ -53,7 +53,6 @@ test_that("to_report works to control log output elements", { axecute(scriptPath, log_name = "log_out_report", log_path = logDir, - remove_log_object = FALSE, to_report = c("messages", "result")) con <- file(file.path(logDir, "log_out_report"), "r") flines <- readLines(con) @@ -83,7 +82,6 @@ test_that("include_rds works to output log as rds", { axecute(scriptPath, log_name = "log_out_nested", log_path = logDir, - remove_log_object = FALSE, include_rds = TRUE, to_report = c("messages", "result")) con <- file(file.path(logDir, "log_out_nested.Rds"), "r") diff --git a/vignettes/approved.Rmd b/vignettes/approved.Rmd index 087bd07..c0aedc8 100644 --- a/vignettes/approved.Rmd +++ b/vignettes/approved.Rmd @@ -146,7 +146,7 @@ close(fileConn) ``` ```{r results='hide'} -axecute(file.path(dir,"mpg.R"), remove_log_object = FALSE) +axecute(file.path(dir,"mpg.R")) ``` Here we have the log elements for "Used Package and Functions" and From 57293841059b0e979bbb3e3c2a9e63a43c18bf39 Mon Sep 17 00:00:00 2001 From: Sam Parmar <107635309+parmsam-pfizer@users.noreply.github.com> Date: Thu, 13 Jul 2023 21:44:04 -0400 Subject: [PATCH 38/99] fix test and approved vignette to pass remove_log_obj TRUE condition --- man/axecute.Rd | 4 ---- tests/testthat/test-sha1.R | 28 +++++++++++++--------------- vignettes/approved.Rmd | 5 ++++- 3 files changed, 17 insertions(+), 20 deletions(-) diff --git a/man/axecute.Rd b/man/axecute.Rd index 9784fd5..3783618 100644 --- a/man/axecute.Rd +++ b/man/axecute.Rd @@ -8,7 +8,6 @@ axecute( file, log_name = NA, log_path = NA, - remove_log_object = TRUE, include_rds = FALSE, quit_on_error = TRUE, to_report = c("messages", "output", "result") @@ -21,9 +20,6 @@ axecute( \item{log_path}{String. Path to log file} -\item{remove_log_object}{Boolean. Should the log object be removed after -writing the log file? Defaults to TRUE} - \item{include_rds}{Boolean. Option to export log object as Rds file. Defaults to FALSE} diff --git a/tests/testthat/test-sha1.R b/tests/testthat/test-sha1.R index d233955..b23d4d4 100644 --- a/tests/testthat/test-sha1.R +++ b/tests/testthat/test-sha1.R @@ -25,11 +25,10 @@ test_that("Test 2: File HashSum generated for temp file", { "data.frame(c(8, 6, 7, 5, 3, 0, 9))"), con = scriptPath) - axecute(scriptPath, - log_name = "log_out_report", - log_path = logDir, - remove_log_object = FALSE, - to_report = c("messages", "result")) + log_config(scriptPath, log_name = "log_out_report", log_path = logDir) + logrx:::run_safely_loudly(scriptPath) + log_write(scriptPath, remove_log_object = FALSE, to_report = c("messages", "result")) + con <- file(file.path(logDir, "log_out_report"), "r") flines <- readLines(con) close(con) @@ -51,11 +50,11 @@ test_that("Test 3: Different File HashSum generated for similar temp file with s "data.frame(c(8, 6, 7, 5, 3, 0, 9))"), con = scriptPath) - axecute(scriptPath, - log_name = "log_out_report", - log_path = logDir, - remove_log_object = FALSE, - to_report = c("messages", "result")) + log_config(scriptPath, log_name = "log_out_report", log_path = logDir) + logrx:::run_safely_loudly(scriptPath) + log_write(scriptPath, remove_log_object = FALSE, to_report = c("messages", "result")) + + con <- file(file.path(logDir, "log_out_report"), "r") flines <- readLines(con) close(con) @@ -76,11 +75,10 @@ test_that("Test 4: Same File HashSum generated for temp file in Test 2", { "data.frame(c(8, 6, 7, 5, 3, 0, 9))"), con = scriptPath) - axecute(scriptPath, - log_name = "log_out_report", - log_path = logDir, - remove_log_object = FALSE, - to_report = c("messages", "result")) + log_config(scriptPath, log_name = "log_out_report", log_path = logDir) + logrx:::run_safely_loudly(scriptPath) + log_write(scriptPath, remove_log_object = FALSE, to_report = c("messages", "result")) + con <- file(file.path(logDir, "log_out_report"), "r") flines <- readLines(con) close(con) diff --git a/vignettes/approved.Rmd b/vignettes/approved.Rmd index c0aedc8..f815c22 100644 --- a/vignettes/approved.Rmd +++ b/vignettes/approved.Rmd @@ -146,7 +146,10 @@ close(fileConn) ``` ```{r results='hide'} -axecute(file.path(dir,"mpg.R")) +fp <- file.path(dir,"mpg.R") +log_config(fp) +logrx:::run_safely_loudly(fp) +log_write(fp, remove_log_object = FALSE) ``` Here we have the log elements for "Used Package and Functions" and From cb0a8fa6fd51461ea01348687189112853518d00 Mon Sep 17 00:00:00 2001 From: Sam Parmar <107635309+parmsam-pfizer@users.noreply.github.com> Date: Thu, 13 Jul 2023 21:48:14 -0400 Subject: [PATCH 39/99] update news md file --- NEWS.md | 1 + 1 file changed, 1 insertion(+) diff --git a/NEWS.md b/NEWS.md index d8764f4..ef841bb 100644 --- a/NEWS.md +++ b/NEWS.md @@ -2,6 +2,7 @@ - Moved website theme to bootstarp 5, enabled search (#179) - Add `include_rds` argument to `axecute()` to export log as rds file +- Remove argument for remove_log_object from `axecute()` still accessible via `log_write()` # logrx 0.2.2 From 9d1259155d1d7d808ef1ac184c18f6d98f7dc00b Mon Sep 17 00:00:00 2001 From: ThomasP-B Date: Mon, 24 Jul 2023 16:55:13 +0200 Subject: [PATCH 40/99] Add write packages permissions --- .github/workflows/spellcheck.yaml | 2 ++ 1 file changed, 2 insertions(+) diff --git a/.github/workflows/spellcheck.yaml b/.github/workflows/spellcheck.yaml index 3928703..967a32e 100644 --- a/.github/workflows/spellcheck.yaml +++ b/.github/workflows/spellcheck.yaml @@ -14,6 +14,8 @@ on: jobs: check: runs-on: ubuntu-latest + permissions: + packages: write name: Spellcheck steps: - name: Checkout repo From c25ee9b6a50f84fe40c1d273d08fd1102cfb90b5 Mon Sep 17 00:00:00 2001 From: Sam Parmar <107635309+parmsam-pfizer@users.noreply.github.com> Date: Mon, 24 Jul 2023 11:38:35 -0500 Subject: [PATCH 41/99] resolve test-parse error --- tests/testthat/test-parse.R | 14 +++++++++++--- 1 file changed, 11 insertions(+), 3 deletions(-) diff --git a/tests/testthat/test-parse.R b/tests/testthat/test-parse.R index 5781566..528a4b1 100644 --- a/tests/testthat/test-parse.R +++ b/tests/testthat/test-parse.R @@ -13,7 +13,7 @@ test_that("read_log_file will parse a logrx log file and create the necessary ob # check that the log file can be parsed parsedFile <- read_log_file(filePath) - expect_length(parsedFile, 7) + expect_length(parsedFile, 9) expect_named( parsedFile, c( @@ -23,17 +23,25 @@ test_that("read_log_file will parse a logrx log file and create the necessary ob "Masked Functions", "Used Package and Functions", "Program Run Time Information", + "Errors and Warnings", + "Messages, Output, and Result", "Log Output File" ) ) expect_true(all(sapply( - parsedFile[names(parsedFile) != "Session Information"], + parsedFile[!names(parsedFile) %in% + c("Session Information", + "Messages, Output, and Result", + "Errors and Warnings")], is.data.frame ))) expect_true( all(sapply( - parsedFile[names(parsedFile) != "Session Information"], + parsedFile[!names(parsedFile) %in% + c("Session Information", + "Messages, Output, and Result", + "Errors and Warnings")], nrow ) > 0) ) From 237917e4bed6df95e047b9fe5db233149fcd22f0 Mon Sep 17 00:00:00 2001 From: Nicholas Masel Date: Tue, 25 Jul 2023 13:22:47 +0000 Subject: [PATCH 42/99] 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 3c3d70103edb7ab28b65f7da8a71e984b645140d Mon Sep 17 00:00:00 2001 From: Sam Parmar <107635309+parmsam-pfizer@users.noreply.github.com> Date: Thu, 27 Jul 2023 09:33:45 -0500 Subject: [PATCH 43/99] Update NEWS.md Co-authored-by: Nicholas Masel <61123199+nicholas-masel@users.noreply.github.com> --- NEWS.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/NEWS.md b/NEWS.md index ad63559..58a8c7e 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,6 +1,6 @@ # logrx 0.3.0 -- Add `show_repo_url` option in `axecute()` to capture repo URL(s) into log file +- Add `show_repo_url` option in `axecute()` to capture repo URL(s) into log file (#167) - Moved website theme to bootstarp 5, enabled search (#179) - Add `include_rds` argument to `axecute()` to export log as rds file From c5809caa254bf99f91dd4abbf758370c36c84713 Mon Sep 17 00:00:00 2001 From: Sam Parmar <107635309+parmsam-pfizer@users.noreply.github.com> Date: Thu, 27 Jul 2023 09:33:55 -0500 Subject: [PATCH 44/99] Update R/axecute.R Co-authored-by: Nicholas Masel <61123199+nicholas-masel@users.noreply.github.com> --- R/axecute.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/axecute.R b/R/axecute.R index aa45f84..48efd02 100644 --- a/R/axecute.R +++ b/R/axecute.R @@ -19,7 +19,7 @@ #' * messages: any messages generated by program execution #' * output: any output generated by program execution #' * result: any result generated by program execution -#' @param show_repo_url Boolean. Should the repo URLs be reported +#' @param show_repo_url Boolean. Should the repository URLs be reported #' Defaults to FALSE #' #' @importFrom purrr map_chr From f9f567d360cb11257fd3e2b42c9699ce4f39b81a Mon Sep 17 00:00:00 2001 From: Nicholas Masel Date: Fri, 4 Aug 2023 16:09:46 +0000 Subject: [PATCH 45/99] add library lint --- NAMESPACE | 1 + R/library_call_linter.R | 73 ++++++++++++++++++++++++++++++++++++++ R/log.R | 15 ++++++++ man/library_call_linter.Rd | 50 ++++++++++++++++++++++++++ tests/testthat/ref/ex7.R | 8 +++++ tests/testthat/test-get.R | 47 ++++++++++++++++++++++++ 6 files changed, 194 insertions(+) create mode 100644 R/library_call_linter.R create mode 100644 man/library_call_linter.Rd create mode 100644 tests/testthat/ref/ex7.R diff --git a/NAMESPACE b/NAMESPACE index 459e1d7..21a21f3 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -2,6 +2,7 @@ export(axecute) export(build_approved) +export(library_call_linter) export(log_config) export(log_init) export(log_remove) diff --git a/R/library_call_linter.R b/R/library_call_linter.R new file mode 100644 index 0000000..45ccd71 --- /dev/null +++ b/R/library_call_linter.R @@ -0,0 +1,73 @@ +#' Library call linter +#' +#' Force library calls to all be at the top of the script. +#' +#' @examples +#' # will produce lints +#' lint( +#' text = " +#' library(dplyr) +#' print('test') +#' library(tidyr) +#' ", +#' linters = library_call_linter() +#' ) +#' +#' lint( +#' text = " +#' library(dplyr) +#' print('test') +#' library(tidyr) +#' library(purrr) +#' ", +#' linters = library_call_linter() +#' ) +#' +#' # okay +#' lint( +#' text = " +#' library(dplyr) +#' print('test') +#' ", +#' linters = library_call_linter() +#' ) +#' +#' lint( +#' text = " +#' # comment +#' library(dplyr) +#' ", +#' linters = library_call_linter() +#' ) +#' +#' @export +library_call_linter <- function() { + + xpath <- " + (//SYMBOL_FUNCTION_CALL[text() = 'library'])[last()] + /preceding::expr + /SYMBOL_FUNCTION_CALL[text() != 'library'][last()] + /following::expr[SYMBOL_FUNCTION_CALL[text() = 'library']] + " + + Linter(function(source_expression) { + if (!is_lint_level(source_expression, "file")) { + return(list()) + } + + xml <- source_expression$full_xml_parsed_content + + bad_expr <- xml2::xml_find_all(xml, xpath) + + if (length(bad_expr) == 0L) { + return(list()) + } + + xml_nodes_to_lints( + bad_expr, + source_expression = source_expression, + lint_message = "Move all library calls to the top of the script.", + type = "warning" + ) + }) +} diff --git a/R/log.R b/R/log.R index ff80c3f..420570f 100644 --- a/R/log.R +++ b/R/log.R @@ -106,7 +106,22 @@ log_config <- function(file = NA, log_name = NA, log_path = NA){ set_log_element("start_time", strftime(Sys.time(), usetz = TRUE)) # log name and path set_log_name_path(log_name, log_path) + # lint results + # mandatory library lint if using the log.rx.approved option + # this is required due to how functions are found in logrx + # it requires a stable search path for the entire script + lints <- getOption("log.rx.lint") + lint_names <- purrr::map(lints, ~ attr(.x, "name")) + is_lint_present <- "library_call_linter" %in% lint_names + + # lint defaults to a logical + if(is.logical(lints)){ + options(log.rx.lint = c(library_call_linter())) + } else if(!is_lint_present){ + options(log.rx.lint = c(lints, library_call_linter())) + } + set_log_element("lint_results", get_lint_results(file)) } diff --git a/man/library_call_linter.Rd b/man/library_call_linter.Rd new file mode 100644 index 0000000..f071e80 --- /dev/null +++ b/man/library_call_linter.Rd @@ -0,0 +1,50 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/library_call_linter.R +\name{library_call_linter} +\alias{library_call_linter} +\title{Library call linter} +\usage{ +library_call_linter() +} +\description{ +Force library calls to all be at the top of the script. +} +\examples{ +# will produce lints +lint( + text = " + library(dplyr) + print('test') + library(tidyr) + ", + linters = library_call_linter() +) + +lint( + text = " + library(dplyr) + print('test') + library(tidyr) + library(purrr) + ", + linters = library_call_linter() +) + +# okay +lint( + text = " + library(dplyr) + print('test') + ", + linters = library_call_linter() +) + +lint( + text = " + # comment + library(dplyr) + ", + linters = library_call_linter() +) + +} diff --git a/tests/testthat/ref/ex7.R b/tests/testthat/ref/ex7.R new file mode 100644 index 0000000..17a364f --- /dev/null +++ b/tests/testthat/ref/ex7.R @@ -0,0 +1,8 @@ +# testing for lint +library(dplyr) + +print('test') + +library(purrr) + +d <<- 2 diff --git a/tests/testthat/test-get.R b/tests/testthat/test-get.R index ac09c5f..ce5fda6 100644 --- a/tests/testthat/test-get.R +++ b/tests/testthat/test-get.R @@ -159,3 +159,50 @@ test_that("lint returns expected result when option is not set", { expect_identical(get_lint_results(filename), NULL) }) + +test_that("library lint returns expected result when option is not set", { + options("log.rx" = NULL) + withr::local_options(log.rx.lint = FALSE) + filename <- test_path("ref", "ex7.R") + + # get is called within log_config + log_config(filename) + + expected <- "Line 6 [library_call_linter] Move all library calls to the top of the script." + + expect_identical(write_lint_results(), expected) +}) + +test_that("library lint returns expected result when option is set", { + options("log.rx" = NULL) + withr::local_options(log.rx.lint = c(library_call_linter())) + filename <- test_path("ref", "ex7.R") + + # get is called within log_config + log_config(filename) + + expected <- "Line 6 [library_call_linter] Move all library calls to the top of the script." + + expect_identical(write_lint_results(), expected) +}) + +test_that("library lint returns expected result when option is set", { + options("log.rx" = NULL) + withr::local_options(log.rx.lint = c(lintr::undesirable_operator_linter())) + filename <- test_path("ref", "ex7.R") + + # get is called within log_config + log_config(filename) + + expected <- paste0( + "Line 6 [library_call_linter] Move all library calls to the ", + "top of the script.\n\nLine 8 [undesirable_operator_linter] Operator ", + "`<<-` is undesirable. It\nassigns outside the current environment in a ", + "way that can be hard to reason\nabout. Prefer fully-encapsulated ", + "functions wherever possible, or, if\nnecessary, assign to a specific ", + "environment with assign(). Recall that you\ncan create an environment ", + "at the desired scope with new.env()." + ) + + expect_identical(write_lint_results(), expected) +}) From 683334e28fdceab74707160cd7f09107296e6ce5 Mon Sep 17 00:00:00 2001 From: Nicholas Masel Date: Fri, 4 Aug 2023 17:45:58 +0000 Subject: [PATCH 46/99] add lint, xml2 dependencies --- DESCRIPTION | 3 ++- NAMESPACE | 4 ++++ R/library_call_linter.R | 3 +++ R/writer.R | 4 ++++ tests/testthat/test-get.R | 1 + tests/testthat/test-writer.R | 5 +++++ 6 files changed, 19 insertions(+), 1 deletion(-) diff --git a/DESCRIPTION b/DESCRIPTION index dda1046..c76e108 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -50,7 +50,8 @@ Imports: waiter, tibble, digest, - lintr + lintr, + xml2 Suggests: testthat (>= 3.0.0), knitr, diff --git a/NAMESPACE b/NAMESPACE index 21a21f3..0eef9ae 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -18,7 +18,10 @@ importFrom(dplyr,group_by) importFrom(dplyr,mutate) importFrom(dplyr,select) importFrom(dplyr,ungroup) +importFrom(lintr,Linter) +importFrom(lintr,is_lint_level) importFrom(lintr,lint) +importFrom(lintr,xml_nodes_to_lints) importFrom(magrittr,"%>%") importFrom(miniUI,gadgetTitleBar) importFrom(miniUI,miniContentPanel) @@ -67,3 +70,4 @@ importFrom(waiter,spin_solar) importFrom(waiter,useWaiter) importFrom(waiter,waiter_hide) importFrom(waiter,waiter_show) +importFrom(xml2,xml_find_all) diff --git a/R/library_call_linter.R b/R/library_call_linter.R index 45ccd71..6a2934f 100644 --- a/R/library_call_linter.R +++ b/R/library_call_linter.R @@ -2,6 +2,9 @@ #' #' Force library calls to all be at the top of the script. #' +#' @importFrom lintr lint Linter xml_nodes_to_lints is_lint_level +#' @importFrom xml2 xml_find_all +#' #' @examples #' # will produce lints #' lint( diff --git a/R/writer.R b/R/writer.R index b114546..c51a978 100644 --- a/R/writer.R +++ b/R/writer.R @@ -275,6 +275,10 @@ write_result <- function() { write_lint_results <- function(){ lint_results <- get_log_element("lint_results") + if (length(lint_results) == 0) { + return("") + } + lint_df <- as.data.frame(lint_results) lint_df$lint_messages <- paste0("Line ", diff --git a/tests/testthat/test-get.R b/tests/testthat/test-get.R index ce5fda6..2bdf6d7 100644 --- a/tests/testthat/test-get.R +++ b/tests/testthat/test-get.R @@ -155,6 +155,7 @@ test_that("lint returns expected result when option is set", { test_that("lint returns expected result when option is not set", { filename <- test_path("ref", "ex6.R") + withr::local_options(log.rx.lint = FALSE) source(filename, local = TRUE) expect_identical(get_lint_results(filename), NULL) diff --git a/tests/testthat/test-writer.R b/tests/testthat/test-writer.R index dcd6d98..d34fe3b 100644 --- a/tests/testthat/test-writer.R +++ b/tests/testthat/test-writer.R @@ -210,3 +210,8 @@ test_that("write_lint_results will return a formatted lint results element", { log_remove() }) + +test_that("write_lint_results works when linter is used but no lints found", { + +}) + From dd3bbd6c2021cd459e9f59c8d3e29b5b07f1f495 Mon Sep 17 00:00:00 2001 From: Nicholas Masel Date: Fri, 4 Aug 2023 17:54:28 +0000 Subject: [PATCH 47/99] fix examples --- R/library_call_linter.R | 2 ++ man/library_call_linter.Rd | 2 ++ 2 files changed, 4 insertions(+) diff --git a/R/library_call_linter.R b/R/library_call_linter.R index 6a2934f..6cf220f 100644 --- a/R/library_call_linter.R +++ b/R/library_call_linter.R @@ -6,6 +6,8 @@ #' @importFrom xml2 xml_find_all #' #' @examples +#' library(lintr) +#' #' # will produce lints #' lint( #' text = " diff --git a/man/library_call_linter.Rd b/man/library_call_linter.Rd index f071e80..cb06b92 100644 --- a/man/library_call_linter.Rd +++ b/man/library_call_linter.Rd @@ -10,6 +10,8 @@ library_call_linter() Force library calls to all be at the top of the script. } \examples{ +library(lintr) + # will produce lints lint( text = " From 8e8238fc76984a36ae95248e5a91ed3dccbdea94 Mon Sep 17 00:00:00 2001 From: Nicholas Masel Date: Mon, 7 Aug 2023 12:56:24 +0000 Subject: [PATCH 48/99] lint write test --- tests/testthat/test-writer.R | 11 +++++++++++ 1 file changed, 11 insertions(+) diff --git a/tests/testthat/test-writer.R b/tests/testthat/test-writer.R index d34fe3b..82b9800 100644 --- a/tests/testthat/test-writer.R +++ b/tests/testthat/test-writer.R @@ -212,6 +212,17 @@ test_that("write_lint_results will return a formatted lint results element", { }) test_that("write_lint_results works when linter is used but no lints found", { + filename <- test_path("ref", "ex6.R") + source(filename, local = TRUE) + + options("log.rx" = NULL) + log_config(filename) + lint_results <- lintr::lint(filename, c(library_call_linter())) + assign('lint_results', lint_results, envir = getOption('log.rx')) + expect_identical( + write_lint_results(), + "" + ) }) From 64316e6b4b2634bc25cd41e7102e06f994f4f2d1 Mon Sep 17 00:00:00 2001 From: Nicholas Masel Date: Mon, 7 Aug 2023 13:09:33 +0000 Subject: [PATCH 49/99] update news --- NEWS.md | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/NEWS.md b/NEWS.md index d8764f4..08f67d9 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,7 +1,8 @@ # logrx 0.3.0 -- Moved website theme to bootstarp 5, enabled search (#179) +- Moved website theme to bootstrap 5, enabled search (#179) - 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) # logrx 0.2.2 From bca16137505fbaee736d709a6af506358c16bfb9 Mon Sep 17 00:00:00 2001 From: Nicholas Masel Date: Mon, 7 Aug 2023 13:23:12 +0000 Subject: [PATCH 50/99] pkgdown update --- _pkgdown.yml | 1 + 1 file changed, 1 insertion(+) diff --git a/_pkgdown.yml b/_pkgdown.yml index e9bc99b..5149bb1 100644 --- a/_pkgdown.yml +++ b/_pkgdown.yml @@ -40,6 +40,7 @@ reference: - contents: - build_approved - approved + - library_call_linter articles: - title: Use Cases From 8c9d65b2f5f96f17f9ee30ed7f331613a4f32f0c Mon Sep 17 00:00:00 2001 From: Sam Parmar <107635309+parmsam-pfizer@users.noreply.github.com> Date: Mon, 7 Aug 2023 11:32:54 -0500 Subject: [PATCH 51/99] hide remove log obj false code block --- vignettes/approved.Rmd | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/vignettes/approved.Rmd b/vignettes/approved.Rmd index f815c22..3751205 100644 --- a/vignettes/approved.Rmd +++ b/vignettes/approved.Rmd @@ -145,7 +145,7 @@ writeLines(text, fileConn) close(fileConn) ``` -```{r results='hide'} +```{r results='hide', echo = FALSE} fp <- file.path(dir,"mpg.R") log_config(fp) logrx:::run_safely_loudly(fp) From 5510b438701a255a9be1f7064fb6fcc1a63a2bd1 Mon Sep 17 00:00:00 2001 From: Sam Parmar <107635309+parmsam-pfizer@users.noreply.github.com> Date: Mon, 7 Aug 2023 12:57:47 -0500 Subject: [PATCH 52/99] add lifecycle deprecration stop --- DESCRIPTION | 3 ++- R/axecute.R | 8 +++++++- 2 files changed, 9 insertions(+), 2 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index dda1046..d0cbbc7 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -50,7 +50,8 @@ Imports: waiter, tibble, digest, - lintr + lintr, + lifecycle Suggests: testthat (>= 3.0.0), knitr, diff --git a/R/axecute.R b/R/axecute.R index 8578b6a..3538fdd 100644 --- a/R/axecute.R +++ b/R/axecute.R @@ -35,7 +35,13 @@ axecute <- function(file, log_name = NA, log_path = NA, include_rds = FALSE, quit_on_error = TRUE, - to_report = c("messages", "output", "result")){ + to_report = c("messages", "output", "result"), + ...){ + + # deprecations + if (!hasArg(remove_log_object)) { + lifecycle::deprecate_stop("0.3.0", "axecute(remove_log_object = )", "axecute(include_rds = )") + } # remove log object remove_log_object <- TRUE From d2b00f432fa261469f43758fbfc0d6f7dc2edc1b Mon Sep 17 00:00:00 2001 From: Sam Parmar <107635309+parmsam-pfizer@users.noreply.github.com> Date: Mon, 7 Aug 2023 13:00:38 -0500 Subject: [PATCH 53/99] add ... to axecute roxygen2 --- R/axecute.R | 1 + man/axecute.Rd | 5 ++++- 2 files changed, 5 insertions(+), 1 deletion(-) diff --git a/R/axecute.R b/R/axecute.R index 3538fdd..7e61799 100644 --- a/R/axecute.R +++ b/R/axecute.R @@ -17,6 +17,7 @@ #' * messages: any messages generated by program execution #' * output: any output generated by program execution #' * result: any result generated by program execution +#' @param ... Not used #' #' @importFrom purrr map_chr #' diff --git a/man/axecute.Rd b/man/axecute.Rd index 3783618..5e69fdf 100644 --- a/man/axecute.Rd +++ b/man/axecute.Rd @@ -10,7 +10,8 @@ axecute( log_path = NA, include_rds = FALSE, quit_on_error = TRUE, - to_report = c("messages", "output", "result") + to_report = c("messages", "output", "result"), + ... ) } \arguments{ @@ -33,6 +34,8 @@ many as necessary: \item output: any output generated by program execution \item result: any result generated by program execution }} + +\item{...}{Not used} } \value{ 0 if there are no errors or 1 if there are any errors From e56d7bf66bed0e8819930a1a2de79d00f0c81ee8 Mon Sep 17 00:00:00 2001 From: Sam Parmar <107635309+parmsam-pfizer@users.noreply.github.com> Date: Mon, 7 Aug 2023 13:06:25 -0500 Subject: [PATCH 54/99] rebuild documentation --- man/axecute.Rd | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/man/axecute.Rd b/man/axecute.Rd index 6db282d..1a3d1cc 100644 --- a/man/axecute.Rd +++ b/man/axecute.Rd @@ -34,8 +34,11 @@ many as necessary: \item messages: any messages generated by program execution \item output: any output generated by program execution \item result: any result generated by program execution -\item{show_repo_url}{Boolean. Should the repo URLs be reported +}} + +\item{show_repo_url}{Boolean. Should the repository URLs be reported Defaults to FALSE} + \item{...}{Not used} } \value{ From a6048e45fe177da6ae31cf2b05a0dffab3e08200 Mon Sep 17 00:00:00 2001 From: Sam Parmar <107635309+parmsam-pfizer@users.noreply.github.com> Date: Mon, 7 Aug 2023 13:55:38 -0500 Subject: [PATCH 55/99] fix axecute unit test --- R/axecute.R | 2 +- tests/testthat/test-axecute.R | 2 -- 2 files changed, 1 insertion(+), 3 deletions(-) diff --git a/R/axecute.R b/R/axecute.R index 9467da0..0b2091a 100644 --- a/R/axecute.R +++ b/R/axecute.R @@ -42,7 +42,7 @@ axecute <- function(file, log_name = NA, show_repo_url = FALSE, ...){ # deprecations - if (!hasArg(remove_log_object)) { + if (hasArg(remove_log_object)) { lifecycle::deprecate_stop("0.3.0", "axecute(remove_log_object = )", "axecute(include_rds = )") } diff --git a/tests/testthat/test-axecute.R b/tests/testthat/test-axecute.R index 32684b2..782de7d 100644 --- a/tests/testthat/test-axecute.R +++ b/tests/testthat/test-axecute.R @@ -81,7 +81,6 @@ test_that("show_repo_url works to show repo url elements", { axecute(scriptPath, log_name = "log_out_repo_url", log_path = logDir, - remove_log_object = FALSE, show_repo_url = TRUE ) con <- file(file.path(logDir, "log_out_repo_url"), "r") @@ -95,7 +94,6 @@ test_that("show_repo_url works to show repo url elements", { axecute(scriptPath, log_name = "log_out_repo_url2", log_path = logDir, - remove_log_object = FALSE, show_repo_url = FALSE ) con <- file(file.path(logDir, "log_out_repo_url2"), "r") From 655fa7a475dc9be9da3a59540e2ba43af7fc7ea8 Mon Sep 17 00:00:00 2001 From: Nicholas Masel Date: Thu, 10 Aug 2023 13:30:30 +0000 Subject: [PATCH 56/99] changed design so library call linter is default --- R/log.R | 15 ------------ R/zzz.R | 2 +- tests/testthat/test-get.R | 51 +++++++++++++-------------------------- vignettes/options.Rmd | 6 ++++- 4 files changed, 23 insertions(+), 51 deletions(-) diff --git a/R/log.R b/R/log.R index 420570f..ff80c3f 100644 --- a/R/log.R +++ b/R/log.R @@ -106,22 +106,7 @@ log_config <- function(file = NA, log_name = NA, log_path = NA){ set_log_element("start_time", strftime(Sys.time(), usetz = TRUE)) # log name and path set_log_name_path(log_name, log_path) - # lint results - # mandatory library lint if using the log.rx.approved option - # this is required due to how functions are found in logrx - # it requires a stable search path for the entire script - lints <- getOption("log.rx.lint") - lint_names <- purrr::map(lints, ~ attr(.x, "name")) - is_lint_present <- "library_call_linter" %in% lint_names - - # lint defaults to a logical - if(is.logical(lints)){ - options(log.rx.lint = c(library_call_linter())) - } else if(!is_lint_present){ - options(log.rx.lint = c(lints, library_call_linter())) - } - set_log_element("lint_results", get_lint_results(file)) } diff --git a/R/zzz.R b/R/zzz.R index a87659e..4970eef 100644 --- a/R/zzz.R +++ b/R/zzz.R @@ -4,7 +4,7 @@ logrx_default_options <- list( log.rx.exec.env = NULL, # Initializes the logrx.lint option - log.rx.lint = FALSE, + log.rx.lint = library_call_linter(), # Initialises the logrx.approved option log.rx.approved = './approved.rds' diff --git a/tests/testthat/test-get.R b/tests/testthat/test-get.R index 2bdf6d7..c7fc21b 100644 --- a/tests/testthat/test-get.R +++ b/tests/testthat/test-get.R @@ -142,54 +142,29 @@ test_that("parse does not fatal error when syntax issue occurs", { expect_identical(get_used_functions(filename), expected) }) -test_that("lint returns expected result when option is set", { - filename <- test_path("ref", "ex6.R") +test_that("lint returns expected result when option is not set", { + filename <- test_path("ref", "ex7.R") source(filename, local = TRUE) - expected <- lint(filename, c(lintr::undesirable_operator_linter())) - - withr::local_options(log.rx.lint = c(lintr::undesirable_operator_linter())) + expected <- lint(filename, library_call_linter()) expect_identical(get_lint_results(filename), expected) }) -test_that("lint returns expected result when option is not set", { +test_that("lint returns expected result when option is changed", { filename <- test_path("ref", "ex6.R") - withr::local_options(log.rx.lint = FALSE) source(filename, local = TRUE) - expect_identical(get_lint_results(filename), NULL) -}) - -test_that("library lint returns expected result when option is not set", { - options("log.rx" = NULL) - withr::local_options(log.rx.lint = FALSE) - filename <- test_path("ref", "ex7.R") - - # get is called within log_config - log_config(filename) - - expected <- "Line 6 [library_call_linter] Move all library calls to the top of the script." - - expect_identical(write_lint_results(), expected) -}) - -test_that("library lint returns expected result when option is set", { - options("log.rx" = NULL) - withr::local_options(log.rx.lint = c(library_call_linter())) - filename <- test_path("ref", "ex7.R") - - # get is called within log_config - log_config(filename) + expected <- lint(filename, c(lintr::undesirable_operator_linter())) - expected <- "Line 6 [library_call_linter] Move all library calls to the top of the script." + withr::local_options(log.rx.lint = c(lintr::undesirable_operator_linter())) - expect_identical(write_lint_results(), expected) + expect_identical(get_lint_results(filename), expected) }) -test_that("library lint returns expected result when option is set", { +test_that("library lint returns expected result when additional option is set", { options("log.rx" = NULL) - withr::local_options(log.rx.lint = c(lintr::undesirable_operator_linter())) + withr::local_options(log.rx.lint = c(getOption("log.rx.lint"), lintr::undesirable_operator_linter())) filename <- test_path("ref", "ex7.R") # get is called within log_config @@ -207,3 +182,11 @@ test_that("library lint returns expected result when option is set", { expect_identical(write_lint_results(), expected) }) + +test_that("lint returns expected result when option is set to FALSE", { + filename <- test_path("ref", "ex6.R") + withr::local_options(log.rx.lint = FALSE) + source(filename, local = TRUE) + + expect_identical(get_lint_results(filename), NULL) +}) diff --git a/vignettes/options.Rmd b/vignettes/options.Rmd index aa10569..cda354e 100644 --- a/vignettes/options.Rmd +++ b/vignettes/options.Rmd @@ -30,7 +30,7 @@ table_ops <- tribble( ~option, ~value, ~description, "log.rx", "An empty R environment", "Used to store log elements during program exection", "log.rx.exec.env", "NULL", "The environment in which the program code is executed", - "[log.rx.lint]", "FALSE", "A `lintr` object for use in lint checking", + "[log.rx.lint]", "library_call_linter()", "A `lintr` object for use in lint checking", "[log.rx.approved]", "./approved.rds", "Location of an approved functions file" ) @@ -51,6 +51,10 @@ If you or your organization would like to implement any linters, you can set you
+Be default, the `library_call_linter()` is used. This is to ensure `logrx` will find the correct package and functions used. + +
+ Hester J, Angly F, Hyde R, Chirico M, Ren K, Rosenstock A, Patil I (2022). lintr: A 'Linter' for R Code. , . ## log.rx.approved From ccc4454537bee4e7e64ffd56164420d592e8f658 Mon Sep 17 00:00:00 2001 From: Sam Parmar <107635309+parmsam-pfizer@users.noreply.github.com> Date: Mon, 14 Aug 2023 12:03:45 -0400 Subject: [PATCH 57/99] Update NEWS.md Co-authored-by: Ben Straub --- NEWS.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/NEWS.md b/NEWS.md index 83efbba..534053c 100644 --- a/NEWS.md +++ b/NEWS.md @@ -3,7 +3,7 @@ - Add `show_repo_url` option in `axecute()` to capture repo URL(s) into log file (#167) - Moved website theme to bootstarp 5, enabled search (#179) - Add `include_rds` argument to `axecute()` to export log as rds file -- Remove argument for remove_log_object from `axecute()` still accessible via `log_write()` +- Remove argument for remove_log_object from `axecute()` still accessible via `log_write()` (#182) # logrx 0.2.2 From 2afa84e4166aed462dba8cf00478283ec81ef95b Mon Sep 17 00:00:00 2001 From: ThomasP-B Date: Mon, 21 Aug 2023 15:58:39 +0100 Subject: [PATCH 58/99] Rewrote action --- .github/workflows/spellcheck.yaml | 18 ++++++++++++------ 1 file changed, 12 insertions(+), 6 deletions(-) diff --git a/.github/workflows/spellcheck.yaml b/.github/workflows/spellcheck.yaml index 967a32e..a055654 100644 --- a/.github/workflows/spellcheck.yaml +++ b/.github/workflows/spellcheck.yaml @@ -12,14 +12,20 @@ on: - dev jobs: - check: + spell: runs-on: ubuntu-latest - permissions: - packages: write - name: Spellcheck + env: + GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }} steps: - - name: Checkout repo - uses: actions/checkout@v3 + - uses: actions/checkout@v3 + + - uses: r-lib/actions/setup-r@v2 + with: + use-public-rspm: true + + - uses: r-lib/actions/setup-r-dependencies@v2 + with: + needs: spelling - name: Run Spelling Check test uses: insightsengineering/r-spellcheck-action@v3 From 70c4329469a7429c15c0cb21a1bad2cbe8096422 Mon Sep 17 00:00:00 2001 From: ThomasP-B Date: Mon, 21 Aug 2023 16:13:45 +0100 Subject: [PATCH 59/99] Implemented spellcheck recommendations --- NEWS.md | 2 +- R/log.R | 2 +- inst/WORDLIST | 20 ++++++++++++++++++++ man/log_init.Rd | 2 +- vignettes/articles/tidylog.Rmd | 2 +- vignettes/execution.Rmd | 12 ++++++------ vignettes/logrx.Rmd | 2 +- 7 files changed, 31 insertions(+), 11 deletions(-) diff --git a/NEWS.md b/NEWS.md index d8764f4..8494fb9 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,6 +1,6 @@ # logrx 0.3.0 -- Moved website theme to bootstarp 5, enabled search (#179) +- Moved website theme to Bootstrap 5, enabled search (#179) - Add `include_rds` argument to `axecute()` to export log as rds file diff --git a/R/log.R b/R/log.R index ff80c3f..a030fef 100644 --- a/R/log.R +++ b/R/log.R @@ -1,6 +1,6 @@ ### Functions to initialise, configure, cleanup, and write the log.rx environment -#' Initialisation of the log.rx environment +#' Initialization of the log.rx environment #' #' `log_init()` initialises the log.rx environment #' diff --git a/inst/WORDLIST b/inst/WORDLIST index 526a8b7..32ac70d 100644 --- a/inst/WORDLIST +++ b/inst/WORDLIST @@ -15,3 +15,23 @@ SDTM tidyr rds logrx +addin +Angly +axecution +customizable +devtools +hashsum +Hotfix +Linter +linters +lintr +logrxpackage +param +Patil +Ren +repo +Rosenstock +Rscript +rx +sessionInfo +tidylog diff --git a/man/log_init.Rd b/man/log_init.Rd index 6900a69..6164303 100644 --- a/man/log_init.Rd +++ b/man/log_init.Rd @@ -2,7 +2,7 @@ % Please edit documentation in R/log.R \name{log_init} \alias{log_init} -\title{Initialisation of the log.rx environment} +\title{Initialization of the log.rx environment} \usage{ log_init() } diff --git a/vignettes/articles/tidylog.Rmd b/vignettes/articles/tidylog.Rmd index 138daf2..afecff0 100644 --- a/vignettes/articles/tidylog.Rmd +++ b/vignettes/articles/tidylog.Rmd @@ -28,7 +28,7 @@ Below we have a simple script using the `us_rent_income` dataset. We will explo
-Using `axecute(ex1_tidylog.R)` we produce a log file. Below we snapshot just the pertinent information for users interested in the `{tidylog}` feeback. This feedback is placed by the `{logrx}` package into the `Messages, Output, and Result` section of the log. +Using `axecute(ex1_tidylog.R)` we produce a log file. Below we snapshot just the pertinent information for users interested in the `{tidylog}` feedback. This feedback is placed by the `{logrx}` package into the `Messages, Output, and Result` section of the log.
diff --git a/vignettes/execution.Rmd b/vignettes/execution.Rmd index bc06725..c0e88f8 100644 --- a/vignettes/execution.Rmd +++ b/vignettes/execution.Rmd @@ -22,10 +22,10 @@ library(logrx) `logrx` has been built with both the flexibility of code execution and a number of different use cases in mind. While the basic case has been outlined in our [Get Started](https://pharmaverse.github.io/logrx/articles/logrx.html) vignette, here we will be discussing different methods of execution and creation of log files. These examples are meant to guide users who wish to explore different methods of execution or for those using ```logrx``` to create scripting. # Methods of Execution -Below you will find a number of examples for different methods of exectuion, these go in an increasing level of complexity and increasing level of technical knowledge. The below examples are meant to be starting points for those interested in using ```logrx``` in more complex settings. +Below you will find a number of examples for different methods of execution, these go in an increasing level of complexity and increasing level of technical knowledge. The below examples are meant to be starting points for those interested in using ```logrx``` in more complex settings. ## `axecute()` -The easiest of the execution methods to use is `axecute()`. This function can be used to exeucte code from an R terminal or using command line scripts. A log is +The easiest of the execution methods to use is `axecute()`. This function can be used to execute code from an R terminal or using command line scripts. A log is set-up around the program, and its code is run safely and loudly (using `safely()` from `{purrr}`). ```{r axecute, eval = FALSE} axecute("my_script.R") @@ -45,7 +45,7 @@ messages, output, and result. This must be passed an executable R file to run a * `log_write()` to generate and format the log -* `log_remove()` to remove the `log.rx` environment created by code exeuction +* `log_remove()` to remove the `log.rx` environment created by code execution ```{r log_*, eval = FALSE} log_config("my_script.R") @@ -55,7 +55,7 @@ log_remove() ``` ## Command Line Execution -While exeucting from an R terminal is nice if you have access to one, you can also execute your code using system command line. This is done using the `Rscript -e` command which executes a file using the registered Rscript executable. Below are a few examples of how to use the command line to execute a file and create a log as well as how to manipulate the outputs of the execution. These are likely to be advanced examples for most users. +While executing from an R terminal is nice if you have access to one, you can also execute your code using system command line. This is done using the `Rscript -e` command which executes a file using the registered Rscript executable. Below are a few examples of how to use the command line to execute a file and create a log as well as how to manipulate the outputs of the execution. These are likely to be advanced examples for most users. The below chunk will run the file my_script.R and output any standard output that is created by the execution of the file to the default location. ```{r, engine = 'bash', eval = FALSE} @@ -87,11 +87,11 @@ r_script_list <- list.files(path = ".", pattern = "\\.R$") lapply(r_script_list, axecute) ``` -Additionally, if you need your code to run using a shell scripting language such as bash these files can be created to run using the previously outlined Command Line Execution examples. The above scripting examples can be translated into a variety of different scritping languages. Below is an example where the bash script is executed in a directory of R files, this should execute all R files in the directory using `axecute()` and create a corresponding set of log files. +Additionally, if you need your code to run using a shell scripting language such as bash these files can be created to run using the previously outlined Command Line Execution examples. The above scripting examples can be translated into a variety of different scripting languages. Below is an example where the bash script is executed in a directory of R files, this should execute all R files in the directory using `axecute()` and create a corresponding set of log files. ```{r, engine = 'bash', eval = FALSE} for file in *.R; do [ -f "$file" ] || continue Rscript -e "logrx::axecute('$file')" done -``` \ No newline at end of file +``` diff --git a/vignettes/logrx.Rmd b/vignettes/logrx.Rmd index db5c0e2..f292a58 100644 --- a/vignettes/logrx.Rmd +++ b/vignettes/logrx.Rmd @@ -67,7 +67,7 @@ list of packages and functions * **Messages, Output and Results (optional)** - List Messages, Outputs and Results * **Log Output File** - Name and path of the log -Below we have a scrollabe example of what is included in a log file for an `adsl.R` script. +Below we have a scrollable example of what is included in a log file for an `adsl.R` script.