Skip to content
Draft
2 changes: 0 additions & 2 deletions DESCRIPTION
Original file line number Diff line number Diff line change
Expand Up @@ -45,9 +45,7 @@ Imports:
rlang,
stats,
tidyr,
stringr,
sessioninfo (>= 1.2),
stringi,
tibble,
digest,
lifecycle,
Expand Down
10 changes: 0 additions & 10 deletions NAMESPACE
Original file line number Diff line number Diff line change
Expand Up @@ -33,16 +33,6 @@ importFrom(purrr,set_names)
importFrom(rlang,.data)
importFrom(sessioninfo,session_info)
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_all)
importFrom(stringr,str_starts)
importFrom(stringr,str_trim)
importFrom(tibble,tibble)
importFrom(tidyr,all_of)
importFrom(tidyr,complete)
Expand Down
1 change: 1 addition & 0 deletions NEWS.md
Original file line number Diff line number Diff line change
Expand Up @@ -5,6 +5,7 @@
## Updates

- Removed .dcf file for old Addin (#280)
- Reworked string handling to use base R and removed `{stringr}`/`{stringi}` dependencies.

## Documentation

Expand Down
3 changes: 1 addition & 2 deletions R/interact.R
Original file line number Diff line number Diff line change
Expand Up @@ -140,7 +140,6 @@ run_file <- function(file) {
#' Safely run an R script and record results, outputs, messages, errors, warnings
#'
#' @importFrom purrr safely discard
#' @importFrom stringr str_starts
#'
#' @param file File to run
#'
Expand All @@ -150,7 +149,7 @@ run_file <- function(file) {
#'
run_safely_loudly <- function(file) {
ret <- loudly(run_safely(file))
set_log_element("messages", discard(ret$messages, ~ str_starts(.x, "Error")))
set_log_element("messages", discard(ret$messages, ~ startsWith(.x, "Error")))
set_log_element("output", ret$output)
set_log_element("result", ret$result$result)
set_log_element("warnings", ret$warnings)
Expand Down
73 changes: 36 additions & 37 deletions R/read_log_file.R
Original file line number Diff line number Diff line change
Expand Up @@ -2,11 +2,6 @@
#'
#' @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
Expand All @@ -19,21 +14,21 @@
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:"
adj_tf <- grepl(
"Errors:|Warnings:|Messages:|Output:|Result:",
i
)
if (adj_tf) {
nrem <- stringr::str_count(i)
i <- stringr::str_remove(i, ":")
char_count <- nchar(i)
i <- sub(":", "", i)
i <-
paste("-", i, paste(rep("-", 54 - nrem), collapse = ""),
paste("-", i, paste(rep("-", 54 - char_count), 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", "=")
i <- gsub("\u2550", "=", i, fixed = TRUE)
i <- gsub("\u2500", "=", i, fixed = TRUE)
adj_log_txt <- c(adj_log_txt, i)
}
return(adj_log_txt)
Expand All @@ -43,8 +38,6 @@ reformat_subsections <- function(log_txt) {
#'
#' @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
Expand All @@ -67,8 +60,7 @@ nest_sections <- function(adj_log_txt) {
}
}
}
sect_headers <-
stringr::str_remove_all(sect_headers, "-?\\s{3,}-?")
sect_headers <- gsub("-?\\s{3,}-?", "", sect_headers)
names(sect_info) <- sect_headers

return(sect_info)
Expand All @@ -79,26 +71,34 @@ nest_sections <- function(adj_log_txt) {
#' @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) {
# Extract the first regex match from each string in `x` using `pattern`.
# x: character vector of strings to inspect.
# pattern: regular expression pattern to extract.
# Returns a character vector the same length as `x`, with `NA` for no match.
extract_match <- function(x, pattern) {
match_positions <- regexpr(pattern, x, perl = TRUE)
result <- rep(NA_character_, length(x))
has_match <- match_positions != -1
if (any(has_match)) {
result[has_match] <- regmatches(x[has_match], match_positions[has_match])
}
result
}

subsect_headers <- stats::na.omit(
stringr::str_extract(adj_log_txt, "[\\-|\\=]\\s\\w+\\s(\\w+\\s)?[\\-|\\=]{3,70}")
extract_match(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, "[\\-|\\=]")
)
latest_subsect <- trimws(gsub("[\\-|\\=]", "", i))
subsect_status <- TRUE
} else if (subsect_status) {
subsect_info[[latest_subsect]] <-
Expand Down Expand Up @@ -135,7 +135,6 @@ nest_log <- function(adj_log_txt) {
#'
#' @importFrom tibble tibble
#' @importFrom tidyr separate
#' @importFrom stringr str_replace_all
#' @importFrom dplyr rename_with
#' @importFrom dplyr mutate
#'
Expand Down Expand Up @@ -170,7 +169,7 @@ parse_log <- function(nested_log) {
parsed_log$`User and File Information` <-
nested_log$`User and File Information` %>%
unlist() %>%
stringr::str_trim() %>%
trimws() %>%
tibble::tibble() %>%
tidyr::separate(".",
sep = "\\: ",
Expand All @@ -182,21 +181,21 @@ parse_log <- function(nested_log) {
parsed_log$`Session Information`$`Session info` <-
nested_log$`Session Information`$`Session info` %>%
unlist() %>%
stringr::str_trim() %>%
trimws() %>%
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))
dplyr::mutate(dplyr::across(tidyselect::where(is.character), trimws))
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("\\*", " ") %>%
gsub("\\*", " ", ., fixed = TRUE) %>%
# account for loaded packages due to load_all()
stringr::str_replace_all(" P ", " ") %>%
gsub(" P ", " ", ., fixed = TRUE) %>%
readr::read_table(skip = 1, col_names = FALSE)

# handle case where log is has 7 columns due to sessioninfo v1.2.2 or earlier
Expand All @@ -213,8 +212,8 @@ parse_log <- function(nested_log) {
"r_version"
)) %>%
dplyr::mutate(
lang = stringr::str_remove(lang, "\\("),
r_version = stringr::str_remove(r_version, "\\)")
lang = sub("\\(", "", lang),
r_version = sub("\\)", "", r_version)
)
} else {
parsed_log$`Session Information`$`Packages` <-
Expand All @@ -230,22 +229,22 @@ parse_log <- function(nested_log) {

parsed_log$`Session Information`$`External software` <-
nested_log$`Session Information`$`External software` %>%
stringr::str_trim() %>%
trimws() %>%
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))
dplyr::mutate(dplyr::across(tidyselect::where(is.character), trimws))
}

if ("Repo URLs" %in% names(nested_log)) {
parsed_log$`Repo URLs` <-
nested_log$`Repo URLs` %>%
unlist() %>%
stringr::str_trim() %>%
trimws() %>%
tibble::tibble() %>%
tidyr::separate(".",
sep = "\\:\\s+",
Expand All @@ -269,7 +268,7 @@ parse_log <- function(nested_log) {
sep = "\\} ",
into = c("library", "function_names")
) %>%
dplyr::mutate(library = stringr::str_remove(library, "\\{"))
dplyr::mutate(library = sub("\\{", "", library))
}

if ("Program Run Time Information" %in% names(nested_log)) {
Expand Down
26 changes: 6 additions & 20 deletions R/writer.R
Original file line number Diff line number Diff line change
Expand Up @@ -43,8 +43,6 @@ write_metadata <- function() {
#' Format log.rx's session info attribute for writing
#'
#' @importFrom purrr map_chr
#' @importFrom stringi stri_wrap
#' @importFrom stringr str_c
#'
#' @return A vector of log.rx's session info attribute
#'
Expand All @@ -59,11 +57,8 @@ write_session_info <- function() {
.x
)) %>%
# wrap any other elements over 80 characters
map_chr(~ stri_wrap(.x,
width = 80, exdent = 2, simplify = FALSE, use_length = TRUE,
normalize = FALSE, whitespace_only = TRUE
) %>%
map_chr(~ str_c(.x, collapse = "\n\t", character(1))))
map_chr(~ strwrap(.x, width = 80, exdent = 2) %>%
paste(collapse = "\n\t"))

return(session_info)
}
Expand Down Expand Up @@ -247,7 +242,7 @@ write_errors <- function() {

paste0(
"Errors:\n\t",
str_replace_all(errors$message, "\n", "\n\t")
gsub("\n", "\n\t", errors$message, fixed = TRUE)
)
}

Expand All @@ -269,15 +264,14 @@ write_warnings <- function() {
#' Format messages attribute for writing
#'
#' @importFrom purrr map
#' @importFrom stringr str_remove_all
#'
#' @return A formatted vector of messages
#'
#' @noRd
#'
write_messages <- function() {
messages <- get_log_element("messages") %>%
map(~ str_remove_all(.x, "\n"))
map(~ gsub("\n", "", .x, fixed = TRUE))

paste0(
"Messages:\n\t",
Expand All @@ -287,8 +281,6 @@ write_messages <- function() {

#' Format output attribute for writing
#'
#' @importFrom stringr str_replace_all
#'
#' @return A formatted vector of output
#'
#' @noRd
Expand All @@ -298,7 +290,7 @@ write_output <- function() {

paste0(
"Output:\n\t",
str_replace_all(output, "\n", "\n\t")
gsub("\n", "\n\t", output, fixed = TRUE)
)
}

Expand Down Expand Up @@ -361,12 +353,6 @@ write_extra_info <- function() {
call. = FALSE
)
}
if (!requireNamespace("stringr", quietly = TRUE)) {
stop(
"Package \"stringr\" must be installed to use this function.",
call. = FALSE
)
}
extra_info <- get_log_element("extra_info")
results <- yaml::as.yaml(
extra_info,
Expand All @@ -375,6 +361,6 @@ write_extra_info <- function() {
logical = yaml::verbatim_logical
)
)
results <- stringr::str_split(results, pattern = "\n")[[1]]
results <- strsplit(results, split = "\n", fixed = TRUE)[[1]]
return(results)
}
21 changes: 21 additions & 0 deletions tests/testthat/test-parse.R
Original file line number Diff line number Diff line change
Expand Up @@ -55,3 +55,24 @@ test_that("read_log_file will parse a logrx log file and create the necessary ob
rm(scriptPath, logDir, parsedFile)
log_remove()
})

test_that("nest_subsections handles both matched and unmatched subsection headers", {
matched_headers <- c("- Session info -------")
section_with_header <- list(
`Session Information` = c("- Session info -------", " setting value", " foo bar")
)

matched_result <- logrx:::nest_subsections(matched_headers, section_with_header)
expect_named(matched_result[[1]], "Session info")
expect_identical(
matched_result[[1]][["Session info"]],
c(" setting value", " foo bar")
)

no_headers <- c("plain text")
section_without_header <- list(`Session Information` = c("line one", "line two"))
unmatched_result <- logrx:::nest_subsections(no_headers, section_without_header)
expect_length(unmatched_result[[1]], 2)
expect_identical(unmatched_result[[1]][[1]], "line one")
expect_identical(unmatched_result[[1]][[2]], "line two")
})
1 change: 0 additions & 1 deletion tests/testthat/test-writer.R
Original file line number Diff line number Diff line change
Expand Up @@ -292,7 +292,6 @@ test_that("write_repo_urls will return a formatted log output element", {

test_that("write_extra_info will return a formatted log output element", {
skip_if_not_installed("yaml")
skip_if_not_installed("stringr")
options("log.rx" = NULL)
ref_extra_info1 <- list("some info", "more info")
fp <- test_path("ref", "safely_loudly_test_file_result.R")
Expand Down
3 changes: 1 addition & 2 deletions vignettes/generate-lockfile.Rmd
Original file line number Diff line number Diff line change
Expand Up @@ -19,7 +19,6 @@ knitr::opts_chunk$set(

```{r setup, message = FALSE}
library(logrx)
library(stringr)
library(dplyr)
library(tidyr)
library(renv)
Expand Down Expand Up @@ -55,7 +54,7 @@ Create a renv lockfile based on the used packages mentioned in the log file.

```{r gen_lockfile, error = TRUE}
pkgs <- parsedFile$`Used Package and Functions` %>%
transmute(package_name = str_extract(library, "(?<=package\\:).+"))
transmute(package_name = sub("package:", "", library, fixed = TRUE))

used_pkgs <- parsedFile$`Session Information`$Packages %>%
filter(package %in% pkgs$package_name)
Expand Down
Loading