diff --git a/.github/workflows/check-standard.yaml b/.github/workflows/check-standard.yaml index e604aee..1e3c19d 100644 --- a/.github/workflows/check-standard.yaml +++ b/.github/workflows/check-standard.yaml @@ -23,9 +23,8 @@ jobs: matrix: config: - {os: windows-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: '4.1', repos: "https://packagemanager.rstudio.com/cran/__linux__/focal/latest"} + - {os: ubuntu-20.04, r: '4.2', repos: "https://packagemanager.rstudio.com/cran/__linux__/focal/latest"} - {os: ubuntu-20.04, r: 'release', rspm: "https://packagemanager.rstudio.com/cran/__linux__/focal/latest"} - {os: ubuntu-20.04, r: 'devel', rspm: "https://packagemanager.rstudio.com/cran/__linux__/focal/latest"} @@ -36,13 +35,13 @@ jobs: GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }} steps: - - uses: actions/checkout@v2 + - uses: actions/checkout@v4 - - uses: r-lib/actions/setup-r@v1 + - uses: r-lib/actions/setup-r@v2 with: r-version: ${{ matrix.config.r }} - - uses: r-lib/actions/setup-pandoc@v1 + - uses: r-lib/actions/setup-pandoc@v2 - name: Query dependencies run: | diff --git a/.github/workflows/spellcheck.yaml b/.github/workflows/spellcheck.yaml new file mode 100644 index 0000000..a055654 --- /dev/null +++ b/.github/workflows/spellcheck.yaml @@ -0,0 +1,33 @@ +--- +name: Spellcheck + +on: + push: + branches: + - main + - dev + pull_request: + branches: + - main + - dev + +jobs: + spell: + runs-on: ubuntu-latest + env: + GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }} + steps: + - 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 + with: + exclude: data/* diff --git a/DESCRIPTION b/DESCRIPTION index 4a5b802..8ef0b88 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.1 Authors@R: c( person(given = "Nathan", @@ -23,6 +23,10 @@ Authors@R: family = "Masel", email = "nmasel@its.jnj.com", role = "aut"), + person(given = "Sam", + family = "Parmar", + email = "samir.parmar@pfizer.com", + role = "aut"), person(given = "GSK/Atorus JPT", role = c("cph", "fnd")) ) @@ -50,7 +54,8 @@ Imports: waiter, tibble, digest, - lintr + lifecycle, + methods Suggests: testthat (>= 3.0.0), knitr, @@ -60,8 +65,12 @@ Suggests: pkgdown, Tplyr, haven, - here + lintr, + xml2, + here, + readr, + tidyselect VignetteBuilder: knitr Config/testthat/edition: 3 Depends: - R (>= 3.5.0) + R (>= 4.0.0) diff --git a/NAMESPACE b/NAMESPACE index 459e1d7..27b9290 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -6,6 +6,7 @@ export(log_config) export(log_init) export(log_remove) export(log_write) +export(read_log_file) export(write_log_header) export(write_unapproved_functions) export(write_used_functions) @@ -15,9 +16,10 @@ importFrom(dplyr,distinct) importFrom(dplyr,filter) importFrom(dplyr,group_by) importFrom(dplyr,mutate) +importFrom(dplyr,rename_with) importFrom(dplyr,select) +importFrom(dplyr,summarize) importFrom(dplyr,ungroup) -importFrom(lintr,lint) importFrom(magrittr,"%>%") importFrom(miniUI,gadgetTitleBar) importFrom(miniUI,miniContentPanel) @@ -51,14 +53,20 @@ 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,all_of) importFrom(tidyr,complete) importFrom(tidyr,pivot_wider) +importFrom(tidyr,separate) importFrom(utils,capture.output) importFrom(utils,getParseData) importFrom(utils,lsf.str) diff --git a/NEWS.md b/NEWS.md index c8d7428..d2cc360 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,3 +1,20 @@ + +# logrx 0.3.1 + + - Hotfix to update used and unapproved packages and functions writing (#218) + +# logrx 0.3.0 + +- Moved website theme to bootstrap 5, enabled search (#179) +- Add `show_repo_url` option in `axecute()` to capture repo URL(s) into log file (#167) +- Moved website theme to Bootstrap 5, enabled search (#179) +- Add `include_rds` argument to `axecute()` to export log as rds file +- Add `read_log_file()` to read logrx log file as optional function +- Add `library_call_linter()` to ensure all library calls are at the top of the script (#163) +- Remove argument for remove_log_object from `axecute()` still accessible via `log_write()` (#182) +- Added functionality so `axecute()` works with `.Rmd` files (#140) +- R Version switched from `>3.5` to `>4.0` in `DESCRIPTION` file (#198) + # 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/R/axecute.R b/R/axecute.R index 7af7930..07a6678 100644 --- a/R/axecute.R +++ b/R/axecute.R @@ -8,8 +8,8 @@ #' @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? #' Defaults to TRUE #' @param to_report String vector. Objects to optionally report, may include as @@ -17,6 +17,9 @@ #' * 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 repository URLs be reported +#' Defaults to FALSE +#' @param ... Not used #' #' @importFrom purrr map_chr #' @@ -31,13 +34,29 @@ #' 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, + include_rds = FALSE, quit_on_error = TRUE, - to_report = c("messages", "output", "result")){ + to_report = c("messages", "output", "result"), + show_repo_url = FALSE, + ...){ + # deprecations + if (methods::hasArg(remove_log_object)) { + lifecycle::deprecate_stop("0.3.0", "axecute(remove_log_object = )", "axecute(include_rds = )") + } + + # remove log object + remove_log_object <- TRUE - # lower everything for consistency and check values + # lower everything for consistency and check values to_report <- map_chr(to_report, tolower) match.arg(to_report, several.ok = TRUE) @@ -51,7 +70,11 @@ 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, + show_repo_url = show_repo_url, + 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/get.R b/R/get.R index 92f4ec7..6f72922 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")) } @@ -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 + } @@ -278,15 +298,33 @@ get_unapproved_use <- function(approved_packages, used_packages) { #' #' @param file File path of file being run #' -#' @importFrom lintr lint -#' #' @return results from `lintr::lint()` #' #' @noRd #' get_lint_results <- function(file) { + + if (!requireNamespace("lintr", quietly = TRUE)) { + message(strwrap("Linting will not be included in the log. Install the + lintr package to use the log.rx.lint feature.", + prefix = " ", initial = "")) + return() + } + # lint file if option is turned on if (!is.logical(getOption('log.rx.lint'))) { - lint(file, getOption('log.rx.lint')) + lintr::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/globals.R b/R/globals.R new file mode 100644 index 0000000..123de60 --- /dev/null +++ b/R/globals.R @@ -0,0 +1,5 @@ +globalVariables(c( + "lang", + "r_version", + "." +)) diff --git a/R/interact.R b/R/interact.R index 959d052..59779c6 100644 --- a/R/interact.R +++ b/R/interact.R @@ -110,6 +110,13 @@ set_log_name_path <- function(log_name = NA, log_path = NA) { #' @noRd run_safely <- function(file) "dummy" +#' Is this a R Markdown file +#' @param file String. Path to file to execute +#' @noRd +is_rmarkdown <- function(file) { + grepl("*.Rmd$", file, ignore.case = TRUE) +} + #' Dummy function for running a file #' @noRd run_file <- function(file){ @@ -118,7 +125,13 @@ run_file <- function(file){ } else{ exec_env <- getOption("log.rx.exec.env") } - source(file, local = exec_env) + + if(is_rmarkdown(file)){ + rmarkdown::render(file, envir = exec_env) + } else{ + source(file, local = exec_env) + } + } #' Safely run an R script and record results, outputs, messages, errors, warnings @@ -139,7 +152,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()) diff --git a/R/library_call_linter.R b/R/library_call_linter.R new file mode 100644 index 0000000..afc86d8 --- /dev/null +++ b/R/library_call_linter.R @@ -0,0 +1,88 @@ +#' Library call linter +#' +#' Force library calls to all be at the top of the script. +#' +#' @examples +#' library(lintr) +#' +#' # 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() +#' ) +#' +#' @noRd +library_call_linter <- function() { + + if (!requireNamespace("lintr", quietly = TRUE)) { + warning(strwrap("Library calls will not be checked to confirm all are at + the top of the script. Install the lintr package to use this feature.", + prefix = " ", initial = "")) + return(list()) + } + if (!requireNamespace("xml2", quietly = TRUE)) { + warning(strwrap("Library calls will not be checked to confirm all are at + the top of the script. Install the xml2 package to use this feature.", + prefix = " ", initial = "")) + return(list()) + } + + xpath <- " + (//SYMBOL_FUNCTION_CALL[text() = 'library'])[last()] + /preceding::expr + /SYMBOL_FUNCTION_CALL[text() != 'library'][last()] + /following::expr[SYMBOL_FUNCTION_CALL[text() = 'library']] + " + + lintr::Linter(function(source_expression) { + if (!lintr::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()) + } + + lintr::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 7e10223..99fbdf4 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 #' @@ -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 @@ -150,10 +153,14 @@ 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. +#' 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 #' information in \code{\link{axecute}} +#' @param show_repo_url Boolean. Should the repo URLs be reported +#' Defaults to FALSE #' #' @return Nothing #' @export @@ -177,6 +184,8 @@ log_cleanup <- function() { #' log_write(file) log_write <- function(file = NA, remove_log_object = TRUE, + show_repo_url = FALSE, + 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)) @@ -210,6 +219,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"), @@ -276,7 +291,7 @@ log_write <- function(file = NA, } if ("result" %in% to_report){ cleaned_log_vec <- c(cleaned_log_vec, - write_result()) + write_result(file)) } cleaned_log_vec <- c(cleaned_log_vec, @@ -285,8 +300,39 @@ log_write <- function(file = NA, write_log_element("log_path", "Log path: ")) writeLines(cleaned_log_vec, - con = file.path(get_log_element("log_path"), - get_log_element("log_name"))) + con = file.path(get_log_element("log_path"), + get_log_element("log_name"))) + 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", + "session_info" + ) + log_options <- as.list(getOption('log.rx')) + 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){ + return(i) + } + } else if(x %in% c(names(log_cleanup()), rds_fields)){ + return(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) { log_remove() } 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/R/read_log_file.R b/R/read_log_file.R new file mode 100644 index 0000000..95e5c4a --- /dev/null +++ b/R/read_log_file.R @@ -0,0 +1,305 @@ +#' Reformat subsections in log lines +#' +#' @param log_txt String vector. Object with log text lines +#' +#' @importFrom stringr str_detect +#' @importFrom stringr str_count +#' @importFrom stringr str_remove +#' @importFrom stringr str_replace_all +#' +#' @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 = "" + ) + } + # replace utf8 line and double line to ascii due to cli symbol variation + i <- stringr::str_replace_all(i, '\u2550', '=') + i <- stringr::str_replace_all(i, '\u2500', '-') + adj_log_txt <- c(adj_log_txt, i) + } + return(adj_log_txt) +} + +#' Nest sections in log lines vector +#' +#' @param adj_log_txt String 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 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 +#' @importFrom stringr str_remove_all +#' +#' @return list that includes nested log subsections +#' +#' @noRd +#' +nest_subsections <- function(adj_log_txt, sect_info) { + subsect_headers <- stats::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 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) + ) +} + +#' Parse nested log list to tibbles for object where appropriate +#' +#' @param nested_log String vector. +#' Object with nested log output (from `nest_log()`) +#' +#' @importFrom tibble tibble +#' @importFrom tidyr separate +#' @importFrom stringr str_replace_all +#' @importFrom dplyr rename_with +#' @importFrom dplyr mutate +#' +#' @return list with objects coerced as tibbles +#' +#' @noRd +#' +parse_log <- function(nested_log) { + if (!requireNamespace("readr", quietly = TRUE)) { + warning(strwrap("Install the readr package to use log parsing feature.", + prefix = " ", initial = "")) + return(list()) + } + + parsed_log <- nested_log + + 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", + fill = "right" + ) + } + + 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", + fill = "right" + ) %>% + dplyr::mutate(dplyr::across(tidyselect::where(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", + fill = "right" + ) %>% + dplyr::mutate(dplyr::across(tidyselect::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 logrx file +#' +#' @param file String. Path to a logrx log file +#' +#' @return Tibble. Object that includes nested and parsed content +#' @export +#' +#' @examples +#' \dontrun{ +#' read_log_file(previous_log_filepath) +#' } +#' +read_log_file <- function(file) { + if (!file.exists(file)) { + stop("Path does not exist:", sQuote(file)) + } + + if (!requireNamespace("readr", quietly = TRUE)) { + warning(strwrap("Install the readr package to use log parsing feature.", + prefix = " ", initial = "")) + return(list()) + } + + 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/R/writer.R b/R/writer.R index f10ac82..059b4ce 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), @@ -62,6 +63,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 @@ -119,6 +142,7 @@ write_masked_functions <- function(){ #' @return Formatted vector of used package functions #' @export #' +#' @importFrom dplyr summarize #' @importFrom purrr map2 #' @importFrom stats aggregate #' @@ -130,7 +154,9 @@ write_masked_functions <- function(){ write_used_functions <- function(){ used_functions_list <- get_log_element("used_packages_functions") - combined <- aggregate(function_name~library, used_functions_list, paste) + combined <- used_functions_list %>% + group_by(library) %>% + summarize(function_name = paste0(.data[["function_name"]], collapse = ", ")) map2(combined$library, combined$function_name, ~paste(paste0("{", .x, "}"), paste0(.y, collapse = ", "))) %>% unname() %>% @@ -160,7 +186,9 @@ write_unapproved_functions <- function(){ return("No unapproved packages or functions used") } - combined <- aggregate(function_name~library, unapproved_functions_list, paste) + combined <- unapproved_functions_list %>% + group_by(library) %>% + summarize(function_name = paste0(.data[["function_name"]], collapse = ", ")) map2(combined$library, combined$function_name, ~paste(paste0("{", .x, "}"), paste0(.y, collapse = ", "))) %>% unname() %>% @@ -259,10 +287,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 @@ -274,6 +306,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/_pkgdown.yml b/_pkgdown.yml index 39a1662..3352e1f 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 @@ -22,6 +35,10 @@ reference: - write_log_header - write_unapproved_functions - write_used_functions +- title: Read Log + desc: Functionality to Read Log Files +- contents: + - read_log_file - title: Utilities desc: Utility functions - contents: diff --git a/inst/WORDLIST b/inst/WORDLIST index 526a8b7..cdd5bf7 100644 --- a/inst/WORDLIST +++ b/inst/WORDLIST @@ -15,3 +15,26 @@ SDTM tidyr rds logrx +addin +Angly +axecution +customizable +devtools +hashsum +Hotfix +Linter +linters +lintr +logrxpackage +param +Patil +Ren +repo +Rosenstock +Rscript +rx +sessionInfo +tidylog +initialises +scrollable +knitr diff --git a/man/axecute.Rd b/man/axecute.Rd index 89e8e67..b16b955 100644 --- a/man/axecute.Rd +++ b/man/axecute.Rd @@ -8,9 +8,11 @@ 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") + to_report = c("messages", "output", "result"), + show_repo_url = FALSE, + ... ) } \arguments{ @@ -20,8 +22,8 @@ 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} \item{quit_on_error}{Boolean. Should the session quit with status 1 on error? Defaults to TRUE} @@ -33,6 +35,11 @@ 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 repository URLs be reported +Defaults to FALSE} + +\item{...}{Not used} } \value{ 0 if there are no errors or 1 if there are any errors @@ -49,4 +56,11 @@ writeLines(text, fileConn) close(fileConn) axecute(file.path(dir, "hello.R")) + + +fileConn <- file(file.path(dir, "hello.Rmd")) +writeLines(text, fileConn) +close(fileConn) + +axecute(file.path(dir, "hello.Rmd")) } diff --git a/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/man/log_write.Rd b/man/log_write.Rd index d269420..906dc09 100644 --- a/man/log_write.Rd +++ b/man/log_write.Rd @@ -7,6 +7,8 @@ log_write( file = NA, remove_log_object = TRUE, + show_repo_url = FALSE, + include_rds = FALSE, to_report = c("messages", "output", "result") ) } @@ -16,6 +18,12 @@ 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}}} } diff --git a/man/read_log_file.Rd b/man/read_log_file.Rd new file mode 100644 index 0000000..6a2d2e6 --- /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 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 logrx file +} +\examples{ +\dontrun{ +read_log_file(previous_log_filepath) +} + +} diff --git a/tests/testthat/Rplots.pdf b/tests/testthat/Rplots.pdf new file mode 100644 index 0000000..7f5ccc9 Binary files /dev/null and b/tests/testthat/Rplots.pdf differ diff --git a/tests/testthat/ref/.gitignore b/tests/testthat/ref/.gitignore index 397b4a7..ade9211 100644 --- a/tests/testthat/ref/.gitignore +++ b/tests/testthat/ref/.gitignore @@ -1 +1,2 @@ *.log +*.html diff --git a/tests/testthat/ref/ex1.Rmd b/tests/testthat/ref/ex1.Rmd new file mode 100644 index 0000000..48daebc --- /dev/null +++ b/tests/testthat/ref/ex1.Rmd @@ -0,0 +1,32 @@ +--- +title: "ex1" +date: "2023-07-06" +output: html_document +--- + +## 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/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-axecute.R b/tests/testthat/test-axecute.R index 8f2dca2..39e6d41 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) @@ -66,3 +65,112 @@ 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, + 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, + 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) +}) + +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, + 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() +}) + +test_that("axecute will run a markdown file and create the necessary log", { + options("log.rx" = NULL) + + scriptPath <- test_path("ref", "ex1.Rmd") + logDir <- tempdir() + + # check no log is currently written out + expect_warning(expect_error(file(file.path(logDir, "rmd_log_out"), "r"), "cannot open the connection")) + + axecute(scriptPath, log_name = "rmd_log_out", log_path = logDir) + con <- file(file.path(logDir, "rmd_log_out"), "r") + flines <- readLines(con) + close(con) + + # check that the output file is populated + expect_gt(length(flines), 1) + # check all the elements are there + expect_true(grepl(paste(write_log_header("logrx Metadata"), collapse = ','), + paste(flines,collapse = ','))) + expect_true(grepl(paste(write_log_header("User and File Information"), collapse = ','), + paste(flines,collapse = ','))) + expect_true(grepl(paste(write_log_header("Session Information"), collapse = ','), + paste(flines,collapse = ','))) + expect_true(grepl(paste(write_log_header("Masked Functions"), collapse = ','), + paste(flines,collapse = ','))) + expect_true(grepl(paste(write_log_header("Program Run Time Information"), collapse = ','), + paste(flines,collapse = ','))) + expect_true(grepl(paste(write_log_header("Errors and Warnings"), collapse = ','), + paste(flines,collapse = ','))) + expect_true(grepl(paste(write_log_header("Messages, Output, and Result"), collapse = ','), + paste(flines,collapse = ','))) + expect_true(grepl(paste(write_log_header("Log Output File"), collapse = ','), + paste(flines,collapse = ','))) + + # remove all the stuff we added + rm(flines, con, scriptPath, logDir) + log_remove() +}) diff --git a/tests/testthat/test-get.R b/tests/testthat/test-get.R index b477174..f7e186d 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", { @@ -142,20 +142,84 @@ 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", { +test_that("lint returns expected result when using the default log.rx.lint option", { + skip_if_not_installed("lintr") + + options("log.rx" = NULL) + filename <- test_path("ref", "ex7.R") + + # get is called within log_config + log_config(filename) + + expect_identical(get_lint_results(filename), NULL) +}) + +test_that("lint returns expected result when option is changed", { + skip_if_not_installed("lintr") + filename <- test_path("ref", "ex6.R") source(filename, local = TRUE) - expected <- lint(filename, c(lintr::undesirable_operator_linter())) + expected <- lintr::lint(filename, c(lintr::undesirable_operator_linter())) withr::local_options(log.rx.lint = c(lintr::undesirable_operator_linter())) expect_identical(get_lint_results(filename), expected) }) -test_that("lint returns expected result when option is not set", { +test_that("library lint returns expected result when multiple linters are set", { + skip_if_not_installed("lintr") + skip_if_not_installed("xml2") + + options("log.rx" = NULL) + withr::local_options(log.rx.lint = c(library_call_linter(), 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) +}) + +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) }) + +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-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'))) diff --git a/tests/testthat/test-parse.R b/tests/testthat/test-parse.R new file mode 100644 index 0000000..8d10c9f --- /dev/null +++ b/tests/testthat/test-parse.R @@ -0,0 +1,53 @@ +test_that("read_log_file will parse a logrx log file and create the necessary object", { + skip_if_not_installed("readr") + 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) + + # check that the log file can be parsed + parsedFile <- read_log_file(filePath) + + expect_length(parsedFile, 9) + expect_named( + parsedFile, + c( + "logrx Metadata", + "User and File Information", + "Session Information", + "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) %in% + c("Session Information", + "Messages, Output, and Result", + "Errors and Warnings")], + is.data.frame + ))) + + expect_true( + all(sapply( + parsedFile[!names(parsedFile) %in% + c("Session Information", + "Messages, Output, and Result", + "Errors and Warnings")], + nrow + ) > 0) + ) + + # remove all the stuff we added + rm(scriptPath, logDir, parsedFile) + log_remove() +}) 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/tests/testthat/test-writer.R b/tests/testthat/test-writer.R index dcd6d98..c90dc1e 100644 --- a/tests/testthat/test-writer.R +++ b/tests/testthat/test-writer.R @@ -176,13 +176,15 @@ 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() }) test_that("write_lint_results will return a formatted lint results element", { + skip_if_not_installed("lintr") + filename <- test_path("ref", "ex6.R") source(filename, local = TRUE) @@ -210,3 +212,22 @@ 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", { + skip_if_not_installed("lintr") + skip_if_not_installed("xml2") + + 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(), + "" + ) +}) + diff --git a/vignettes/approved.Rmd b/vignettes/approved.Rmd index 087bd07..dc64c5a 100644 --- a/vignettes/approved.Rmd +++ b/vignettes/approved.Rmd @@ -145,8 +145,11 @@ writeLines(text, fileConn) close(fileConn) ``` -```{r results='hide'} -axecute(file.path(dir,"mpg.R"), remove_log_object = FALSE) +```{r results='hide', echo = FALSE} +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 @@ -173,3 +176,9 @@ logrx::log_remove() unlink(dir, recursive = TRUE) ``` + +# A Few Words of Caution + +All packages should be attached at the top of the script to set a consistent `?base::searchpaths()` throughout the entire script. This will ensure the functions you use in your script are linked to the correct package. A lint feature is available to test your scripts follow this best practice. + +Some functions are stored within a list, for example `knitr::opts_chunck$get()` and `knitr::opts_current$get()`. We do not currently identify `get()` as a knitr function since it is not exported. 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..021cdaa 100644 --- a/vignettes/logrx.Rmd +++ b/vignettes/logrx.Rmd @@ -37,7 +37,7 @@ A log can be generated using the ```{logrx}``` addin, which is a simple point an # Log attributes -We have compiled a brief overview of the information that we capture in the log file generated by `{logrx}`. We also users to customize sections of the log based on their needs for a log, e.g. you can toggle on/off the messages, outputs, errors and messages. You can also build into your log approved and unapproved packages used in your R script - see [Logging Unapproved Package and Function Use]( https://pharmaverse.github.io/logrx/articles/approved.html) for additional guidance +We have compiled a brief overview of the information that we capture in the log file generated by `{logrx}`. We allow users to customize sections of the log based on their needs for a log, e.g. you can toggle on/off the messages, outputs, errors and messages. You can also build into your log approved and unapproved packages used in your R script - see [Logging Unapproved Package and Function Use]( https://pharmaverse.github.io/logrx/articles/approved.html) for additional guidance The following attributes are recorded in the log: @@ -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.