Merge branch 'dev' into 167_capture_repo_urls

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",

NEWS.md

@@ -1,6 +1,8 @@
 # logrx 0.3.0
 
 - Add `show_repo_url` option in `axecute()` to capture repo URL(s) into log file
+- Moved website theme to bootstarp 5, enabled search (#179)
+- Add `include_rds` argument to `axecute()` to export log as rds file
 
 # logrx 0.2.2
 

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
@@ -36,6 +38,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"),
  show_repo_url = FALSE){
@@ -56,8 +59,9 @@ axecute <- function(file, log_name = NA,
  # write log
  log_write(file = file,
  remove_log_object = remove_log_object,
- to_report = to_report,
- show_repo_url = show_repo_url)
+ 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) {

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"))
 }
 
 
@@ -195,7 +195,7 @@ get_used_functions <- function(file){
  mutate(function_name = coalesce(.data[["SYMBOL_FUNCTION_CALL"]],
  .data[["SPECIAL"]]))
 
- get_library(combine_tokens) %>%
+get_library(combine_tokens) %>%
  select(all_of(c("function_name", "library"))) %>%
  distinct()
 

R/log.R

@@ -153,6 +153,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.
+#' 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
@@ -182,8 +184,9 @@ log_cleanup <- function() {
 #' log_write(file)
 log_write <- function(file = NA,
  remove_log_object = TRUE,
- to_report = c("messages", "output", "result"),
- show_repo_url = FALSE){
+ 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))
  set_log_element("run_time",
@@ -297,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()
  }

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

_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

tests/testthat/test-axecute.R

@@ -68,17 +68,7 @@ test_that("to_report works to control log output elements", {
 })
 
 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"))
+ 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,
@@ -106,5 +96,37 @@ test_that("show_repo_url works to show repo url elements", {
  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,
+ 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()
 })

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", {