From db205b06cfd8a4f7e5a782d55ba57c6ad853e126 Mon Sep 17 00:00:00 2001 From: akselthomsen Date: Fri, 13 Dec 2024 11:31:23 +0100 Subject: [PATCH 01/14] feat: setup pre-commit --- .Rbuildignore | 25 +++++++------- .pre-commit-config.yaml | 74 +++++++++++++++++++++++++++++++++++++++++ 2 files changed, 87 insertions(+), 12 deletions(-) create mode 100644 .pre-commit-config.yaml diff --git a/.Rbuildignore b/.Rbuildignore index f32db70..94754f1 100644 --- a/.Rbuildignore +++ b/.Rbuildignore @@ -1,19 +1,20 @@ -^whirl\.Rproj$ -^\.Rproj\.user$ ^LICENSE\.md$ -^_pkgdown\.yml$ -^docs$ -^pkgdown$ ^README\.Rmd$ -^\.lintr$ +^\.Rproj\.user$ ^\.github$ -^inst/output$ +^\.lintr$ +^\.pre-commit-config\.yaml$ +^_pkgdown\.yml$ +^dev/ +^docs$ ^inst/examples/*\\.html$ ^inst/examples/*_files$ -^dev/ -summary.html -plot1.png -^whirl\.Rcheck$ +^inst/output$ +^pkgdown$ +^vignettes/articles$ ^whirl.*\.tar\.gz$ ^whirl.*\.tgz$ -^vignettes/articles$ +^whirl\.Rcheck$ +^whirl\.Rproj$ +plot1.png +summary.html diff --git a/.pre-commit-config.yaml b/.pre-commit-config.yaml new file mode 100644 index 0000000..8585b0f --- /dev/null +++ b/.pre-commit-config.yaml @@ -0,0 +1,74 @@ +# All available hooks: https://pre-commit.com/hooks.html +# R specific hooks: https://github.com/lorenzwalthert/precommit +repos: +- repo: https://github.com/lorenzwalthert/precommit + rev: v0.4.3.9003 + hooks: + - id: style-files + args: [--style_pkg=styler, --style_fun=tidyverse_style] + - id: roxygenize + - id: use-tidy-description + - id: spell-check + exclude: > + (?x)^( + .*\.[rR]| + .*\.feather| + .*\.jpeg| + .*\.pdf| + .*\.png| + .*\.py| + .*\.RData| + .*\.rds| + .*\.Rds| + .*\.Rproj| + .*\.sh| + (.*/|)\.gitignore| + (.*/|)\.gitlab-ci\.yml| + (.*/|)\.lintr| + (.*/|)\.pre-commit-.*| + (.*/|)\.Rbuildignore| + (.*/|)\.Renviron| + (.*/|)\.Rprofile| + (.*/|)\.travis\.yml| + (.*/|)appveyor\.yml| + (.*/|)NAMESPACE| + (.*/|)renv/settings\.dcf| + (.*/|)renv\.lock| + (.*/|)WORDLIST| + \.github/workflows/.*| + data/.*| + )$ + - id: lintr + - id: readme-rmd-rendered + - id: parsable-R + - id: no-browser-statement + - id: no-print-statement + - id: no-debug-statement + - id: deps-in-desc + - id: pkgdown +- repo: https://github.com/pre-commit/pre-commit-hooks + rev: v5.0.0 + hooks: + - id: check-added-large-files + args: ['--maxkb=200'] + - id: file-contents-sorter + files: '^\.Rbuildignore$' + - id: end-of-file-fixer + exclude: '\.Rd' +- repo: https://github.com/pre-commit-ci/pre-commit-ci-config + rev: v1.6.1 + hooks: + # Only required when https://pre-commit.ci is used for config validation + - id: check-pre-commit-ci-config +- repo: local + hooks: + - id: forbid-to-commit + name: Don't commit common R artifacts + entry: Cannot commit .Rhistory, .RData, .Rds or .rds. + language: fail + files: '\.(Rhistory|RData|Rds|rds)$' + # `exclude: ` to allow committing specific files + +ci: + autoupdate_schedule: monthly + skip: [pkgdown] From 2e0b0509d9e22c46f00f354a3c9d29f404d8635d Mon Sep 17 00:00:00 2001 From: akselthomsen Date: Tue, 17 Dec 2024 15:42:46 +0100 Subject: [PATCH 02/14] start dev version --- DESCRIPTION | 2 +- NEWS.md | 4 ++++ 2 files changed, 5 insertions(+), 1 deletion(-) diff --git a/DESCRIPTION b/DESCRIPTION index 7881c70..cdafabe 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,6 +1,6 @@ Package: whirl Title: Logging package -Version: 0.1.7 +Version: 0.1.7.9000 Authors@R: c( person("Aksel", "Thomsen", , "oath@novonordisk.com", role = c("aut", "cre")), person("Lovemore", "Gakava", , "lvgk@novonordisk.com", role = "aut"), diff --git a/NEWS.md b/NEWS.md index 31ea81b..1176efd 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,3 +1,7 @@ +# whirl dev +* Added pre-commit for developers +* Fixed linting errors + # whirl 0.1.7 (2024-12-17) * Enable redirection of logs through the `log_dir` argument in `run()`. * Changed the title on the individual logs to the script name and moved the path to a distinct section within the title-block. From 70b8296ea2bff658b431884b75d406fd48d5bfd9 Mon Sep 17 00:00:00 2001 From: akselthomsen Date: Wed, 18 Dec 2024 14:32:30 +0100 Subject: [PATCH 03/14] feat: add pre-commit and take care of many simple linting issues --- .pre-commit-config.yaml | 20 ++- R/approvedpkgs.R | 63 ++++++-- R/custom_logging.R | 17 +-- R/enrich_input.R | 36 +++-- R/import-standalone-s3-register.R | 27 ++-- R/internal_run.R | 41 +++--- R/normalize_with_base.R | 17 ++- R/options.R | 27 ++-- R/pb_script.R | 15 +- R/quarto.R | 8 +- R/read_glob.R | 6 +- R/render_summary.R | 21 ++- R/renv.R | 10 +- R/run.R | 133 +++++++++-------- R/session.R | 50 +++++-- R/status.R | 11 +- R/strace.R | 74 ++++++---- R/use_whirl.R | 3 +- R/util_queue_summary.R | 3 +- R/utils.R | 11 +- R/whirl_queue.R | 174 ++++++++++++----------- R/whirl_r_session.R | 104 ++++++++------ README.Rmd | 4 +- README.md | 22 +-- inst/WORDLIST | 81 +++++++++++ inst/documents/dummy.qmd | 15 +- inst/documents/log.qmd | 20 +-- man/custom_logging.Rd | 11 +- man/options.Rd | 26 +++- man/options_params.Rd | 26 +++- man/run.Rd | 36 +++-- man/use_whirl.Rd | 3 +- tests/testthat/helper.R | 2 +- tests/testthat/scripts/error.R | 1 - tests/testthat/scripts/success.R | 1 - tests/testthat/scripts/warning.R | 1 - tests/testthat/test-custom_logging.R | 9 +- tests/testthat/test-enrich_input.R | 9 +- tests/testthat/test-examples.R | 2 - tests/testthat/test-internal_run.R | 2 - tests/testthat/test-read_glob.R | 2 - tests/testthat/test-run.R | 27 ++-- tests/testthat/test-strace.R | 12 -- tests/testthat/test-util_queue_summary.R | 24 ++-- vignettes/articles/example.Rmd | 16 +-- vignettes/whirl.Rmd | 49 ++++--- 46 files changed, 786 insertions(+), 486 deletions(-) create mode 100644 inst/WORDLIST diff --git a/.pre-commit-config.yaml b/.pre-commit-config.yaml index 8585b0f..d8ac1d4 100644 --- a/.pre-commit-config.yaml +++ b/.pre-commit-config.yaml @@ -7,6 +7,22 @@ repos: - id: style-files args: [--style_pkg=styler, --style_fun=tidyverse_style] - id: roxygenize + additional_dependencies: + - checkmate + - dplyr + - ggplot2 + - httr + - jsonlite + - kableExtra + - options + - quarto + - rmarkdown + - sessioninfo + - tibble + - tidyr + - unglue + - NovoNordisk-OpenSource/zephyr + - reticulate - id: use-tidy-description - id: spell-check exclude: > @@ -38,11 +54,11 @@ repos: \.github/workflows/.*| data/.*| )$ - - id: lintr + # - id: lintr - id: readme-rmd-rendered - id: parsable-R - id: no-browser-statement - - id: no-print-statement + # - id: no-print-statement - id: no-debug-statement - id: deps-in-desc - id: pkgdown diff --git a/R/approvedpkgs.R b/R/approvedpkgs.R index 84a704e..bb72c46 100644 --- a/R/approvedpkgs.R +++ b/R/approvedpkgs.R @@ -34,7 +34,10 @@ check_approved <- function(approved_pkg_folder, ) |> dplyr::select("Package", "Version", "Repository") session_pkgs |> - dplyr::left_join(src_url, by = c("package" = "Package", "loadedversion" = "Version")) |> + dplyr::left_join( + y = src_url, + by = c("package" = "Package", "loadedversion" = "Version") + ) |> dplyr::mutate( Approved = ifelse(is.na(.data[["Repository"]]), "No", "Yes"), "Approved Repository" = url @@ -56,7 +59,10 @@ check_approved <- function(approved_pkg_folder, ) |> dplyr::select("Package", "Version", "Repository") session_pkgs |> - dplyr::left_join(src_file, by = c("package" = "Package", "loadedversion" = "Version")) |> + dplyr::left_join( + y = src_file, + by = c("package" = "Package", "loadedversion" = "Version") + ) |> dplyr::mutate( Approved = ifelse(is.na(.data[["Repository"]]), "No", "Yes"), "Approved Repository" = folder @@ -69,17 +75,30 @@ check_approved <- function(approved_pkg_folder, if (is.null(approved_pkg_folder)) { approved_dset <- approved_dset_url |> - dplyr::select("package", "loadedversion", "date", "source", "Approved", "Approved Repository") |> + dplyr::select( + "package", "loadedversion", "date", "source", "Approved", + "Approved Repository" + ) |> dplyr::rename("Repository URL" = "Approved Repository") |> dplyr::arrange(.data[["Approved"]], .data[["package"]]) } else if (is.null(approved_pkg_url) || length(approved_pkg_url) == 0) { approved_dset <- approved_dset_file |> - dplyr::select("package", "loadedversion", "date", "source", "Approved", "Approved Repository") |> + dplyr::select( + "package", "loadedversion", "date", "source", "Approved", + "Approved Repository" + ) |> dplyr::rename("Repository Folder" = "Approved Repository") |> dplyr::arrange(.data[["Approved"]], .data[["package"]]) } else { - approved_dset <- dplyr::full_join(approved_dset_url, approved_dset_file, by = c("package", "loadedversion")) |> - dplyr::select("package", "loadedversion", "date.x", "source.x", "Approved.x", "Approved Repository.x", "Approved.y", "Approved Repository.y") |> + approved_dset <- dplyr::full_join( + x = approved_dset_url, + y = approved_dset_file, + by = c("package", "loadedversion") + ) |> + dplyr::select( + "package", "loadedversion", "date.x", "source.x", "Approved.x", + "Approved Repository.x", "Approved.y", "Approved Repository.y" + ) |> dplyr::rename( "date" = "date.x", "source" = "source.x", @@ -88,7 +107,11 @@ check_approved <- function(approved_pkg_folder, "Approved in Repository URL" = "Approved.x", "Approved in Repository Folder" = "Approved.y" ) |> - dplyr::arrange(.data[["Approved in Repository URL"]], .data[["Approved in Repository Folder"]], .data[["package"]]) + dplyr::arrange( + .data[["Approved in Repository URL"]], + .data[["Approved in Repository Folder"]], + .data[["package"]] + ) } if (is.null(output_file)) { @@ -103,18 +126,36 @@ check_approved <- function(approved_pkg_folder, create_approval_plot <- function(data) { row.names(data) <- NULL - data$grpvar <- ifelse(rowSums(as.matrix(data[, grepl("^Approved", colnames(data))]) == "No") == ncol(as.matrix(data[, grepl("^Approved", colnames(data))])), "No", "Yes") + data$grpvar <- ifelse( + rowSums(as.matrix(data[, grepl("^Approved", colnames(data))]) == "No") == + ncol(as.matrix(data[, grepl("^Approved", colnames(data))])), + "No", "Yes" + ) data |> dplyr::count(.data[["grpvar"]]) |> dplyr::mutate( pct = prop.table(.data[["n"]]), status = "grpvar", - lbl = paste0(.data[["grpvar"]], ": ", .data[["n"]], "/", sum(.data[["n"]]), " (", scale_to_percent(.data[["pct"]]), ")") + lbl = paste0( + .data[["grpvar"]], ": ", + .data[["n"]], "/", + sum(.data[["n"]]), " (", + scale_to_percent(.data[["pct"]]), ")" + ) ) |> - ggplot2::ggplot(ggplot2::aes(x = .data[["pct"]], y = .data[["status"]], fill = .data[["grpvar"]], label = .data[["lbl"]])) + + ggplot2::ggplot( + mapping = ggplot2::aes( + x = .data[["pct"]], + y = .data[["status"]], + fill = .data[["grpvar"]], + label = .data[["lbl"]] + ) + ) + ggplot2::geom_bar(position = "fill", stat = "identity") + - ggplot2::geom_text(position = ggplot2::position_stack(vjust = 0.5, reverse = FALSE)) + + ggplot2::geom_text( + position = ggplot2::position_stack(vjust = 0.5, reverse = FALSE) + ) + ggplot2::theme_void() + ggplot2::theme( legend.position = "none", diff --git a/R/custom_logging.R b/R/custom_logging.R index 12986a1..2874f87 100644 --- a/R/custom_logging.R +++ b/R/custom_logging.R @@ -3,14 +3,15 @@ #' Useful for e.g. read and write operations on databases etc. #' that are not automatically captured. #' -#' The default environment variable `WHIRL_LOG_MSG` is set in the session used to log scripts, and input -#' is automatically captured in the resulting log. +#' The default environment variable `WHIRL_LOG_MSG` is set in the session used +#' to log scripts, and input is automatically captured in the resulting log. #' -#' If run outside of whirl, meaning when the above environment variable is unset, the operations -#' are streamed to `stdout()`. By default the console. +#' If run outside of whirl, meaning when the above environment variable is +#' unset, the operations are streamed to `stdout()`. By default the console. #' #' @name custom_logging -#' @param file [character()] description of the file that was read, written or deleted. +#' @param file [character()] description of the file that was read, written or +#' deleted. #' @param log [character()] path to the log file. NULL @@ -37,17 +38,15 @@ write_to_log <- function( file, type = c("read", "write", "delete"), log = Sys.getenv("WHIRL_LOG_MSG")) { - type <- rlang::arg_match(type) checkmate::assert_string(type) checkmate::assert_string(file) checkmate::assert_string(log) - time <- Sys.time() x <- log_df( type = type, file = file - ) + ) if (log == "") { jsonlite::stream_out(x = x, verbose = FALSE) @@ -60,7 +59,6 @@ write_to_log <- function( #' @noRd read_from_log <- function(log = Sys.getenv("WHIRL_LOG_MSG")) { - if (log == "" || !file.exists(log)) { return(log_df()) } @@ -83,7 +81,6 @@ log_df <- function(type = character(), file = character()) { #' @noRd split_log <- function(log_df, types = c("read", "write", "delete")) { - class(log_df) <- c("whirl_log_info", class(log_df)) # Split in a tibble for each type of output diff --git a/R/enrich_input.R b/R/enrich_input.R index 6575c66..b8b88c6 100644 --- a/R/enrich_input.R +++ b/R/enrich_input.R @@ -8,24 +8,25 @@ #' #' @return A list #' @noRd -enrich_input <- function(input, steps = NULL, - verbosity_level = options::opt("verbosity_level", env = "whirl")) { - +enrich_input <- function( + input, + steps = NULL, + verbosity_level = options::opt("verbosity_level", env = "whirl")) { # Characterize the input is_config_file <- any(grepl("yaml|yml", get_file_ext(input))) is_character <- is.character(input) # Read yaml and extract list - if (is_config_file & length(input) == 1) { + if (is_config_file && length(input) == 1) { root_dir <- dirname(input) config_whirl <- yaml::read_yaml(file = input, eval.expr = TRUE) got <- config_whirl$"steps" } else { - root_dir = getwd() + root_dir <- getwd() } # Convert vector to list - if (is_character & !is_config_file) { + if (is_character && !is_config_file) { got <- list(input) } @@ -36,7 +37,6 @@ enrich_input <- function(input, steps = NULL, names <- list() paths <- list() for (i in seq_along(got)) { - # Identify the step names - if none, then create a default name check_name <- any(grepl("name", names(got[[i]]))) if (check_name) { @@ -56,7 +56,11 @@ enrich_input <- function(input, steps = NULL, # Normalizing the paths and read regexp for (j in seq_along(paths)) { - normalized <- unlist(lapply(paths[[j]], normalize_with_base, base = root_dir)) + normalized <- unlist(lapply( + X = paths[[j]], + FUN = normalize_with_base, + base = root_dir + )) paths[[j]] <- read_glob(normalized) } @@ -72,8 +76,10 @@ enrich_input <- function(input, steps = NULL, } # Merge the names and paths into a list - out <- mapply(list, "name" = names, "paths" = paths, - SIMPLIFY = FALSE) + out <- mapply(list, + "name" = names, "paths" = paths, + SIMPLIFY = FALSE + ) # Get the step names step_names <- unlist(out)[grepl("name", names(unlist(out)))] @@ -81,9 +87,9 @@ enrich_input <- function(input, steps = NULL, # Prune the list when steps have been selected if (!is.null(steps)) { id <- which(step_names %in% steps) - #Update the vector of names + # Update the vector of names step_names <- step_names[id] - #Update the list + # Update the list out <- out[id] } @@ -94,9 +100,9 @@ enrich_input <- function(input, steps = NULL, ) zephyr::msg(message_, - msg_fun = cli::cli_inform, - levels_to_write = "verbose", - verbosity_level = verbosity_level + msg_fun = cli::cli_inform, + levels_to_write = "verbose", + verbosity_level = verbosity_level ) invisible(out) diff --git a/R/import-standalone-s3-register.R b/R/import-standalone-s3-register.R index 15c040b..7f3b0bd 100644 --- a/R/import-standalone-s3-register.R +++ b/R/import-standalone-s3-register.R @@ -3,6 +3,8 @@ # Generated by: usethis::use_standalone("r-lib/rlang", "s3-register") # ---------------------------------------------------------------------- # +# nolint start +# # --- # repo: r-lib/rlang # file: standalone-s3-register.R @@ -42,7 +44,8 @@ #' #' @section Usage in other packages: #' To avoid taking a dependency on rlang, you copy the source of -#' [`s3_register()`](https://github.com/r-lib/rlang/blob/main/R/standalone-s3-register.R) +#' [`s3_register()`] +#' (https://github.com/r-lib/rlang/blob/main/R/standalone-s3-register.R) #' into your own package or with #' `usethis::use_standalone("r-lib/rlang", "s3-register")`. It is licensed under #' the permissive [unlicense](https://choosealicense.com/licenses/unlicense/) to @@ -115,7 +118,10 @@ s3_register <- function(generic, class, method = NULL) { package ), "i" = "This message is only shown to developers using devtools.", - "i" = sprintf("Do you need to update %s to the latest version?", package) + "i" = sprintf( + "Do you need to update %s to the latest version?", + package + ) )) } } @@ -144,24 +150,21 @@ s3_register <- function(generic, class, method = NULL) { .rlang_s3_register_compat <- function(fn, try_rlang = TRUE) { # Compats that behave the same independently of rlang's presence - out <- switch( - fn, + out <- switch(fn, is_installed = return(function(pkg) requireNamespace(pkg, quietly = TRUE)) ) # Only use rlang if it is fully loaded (#1482) if (try_rlang && - requireNamespace("rlang", quietly = TRUE) && - environmentIsLocked(asNamespace("rlang"))) { - switch( - fn, + requireNamespace("rlang", quietly = TRUE) && + environmentIsLocked(asNamespace("rlang"))) { + switch(fn, is_interactive = return(rlang::is_interactive) ) # Make sure rlang knows about "x" and "i" bullets if (utils::packageVersion("rlang") >= "0.4.2") { - switch( - fn, + switch(fn, abort = return(rlang::abort), warn = return((rlang::warn)), inform = return(rlang::inform) @@ -181,8 +184,7 @@ s3_register <- function(generic, class, method = NULL) { } format_msg <- function(x) paste(x, collapse = "\n") - switch( - fn, + switch(fn, is_interactive = return(is_interactive_compat), abort = return(function(msg) stop(format_msg(msg), call. = FALSE)), warn = return(function(msg) warning(format_msg(msg), call. = FALSE)), @@ -193,3 +195,4 @@ s3_register <- function(generic, class, method = NULL) { } # nocov end +# nolint end diff --git a/R/internal_run.R b/R/internal_run.R index afc847d..632099e 100644 --- a/R/internal_run.R +++ b/R/internal_run.R @@ -9,47 +9,52 @@ #' of the steps found in the config file. If kept as NULL (default) then all #' steps listed in the config file will be executed. #' @param queue The whirl_r_queue that should execute the scripts -#' @param level Depth of the recursive config calls. The initial call will have 1 +#' @param level Depth of the recursive config calls. +#' The initial call will have 1. #' @inheritParams options_params #' @return A tibble containing the execution results for all the scripts. #' @noRd -internal_run <- function(input, steps, queue, level, - verbosity_level = options::opt("verbosity_level", env = "whirl")) { - +internal_run <- function( + input, + steps, + queue, + level, + verbosity_level = options::opt("verbosity_level", env = "whirl")) { # Enrich the input with "name" and "path" elements enriched <- enrich_input(input, steps, verbosity_level) # Loop over the elements for (i in seq_along(enriched)) { - files <- enriched[[i]]$path name <- enriched[[i]]$name # Messages cli_level <- get(paste0("cli_h", min(level, 3)), envir = asNamespace("cli")) zephyr::msg(name, - msg_fun = cli_level, - levels_to_write = "verbose", - verbosity_level = verbosity_level) + msg_fun = cli_level, + levels_to_write = "verbose", + verbosity_level = verbosity_level + ) # If the step points to a config file then re-initiate internal_run() if (any(grepl("yaml|yml", get_file_ext(files)))) { - internal_run(input = files, - steps = steps, - queue = queue, - level = level + 1, - verbosity_level = verbosity_level) + internal_run( + input = files, + steps = steps, + queue = queue, + level = level + 1, + verbosity_level = verbosity_level + ) } else { # Execute the scripts queue$run(files) zephyr::msg("\n", - msg_fun = cli::cli_verbatim, - levels_to_write = "verbose", - verbosity_level = verbosity_level) - + msg_fun = cli::cli_verbatim, + levels_to_write = "verbose", + verbosity_level = verbosity_level + ) } } invisible(queue) } - diff --git a/R/normalize_with_base.R b/R/normalize_with_base.R index 2d41545..6de27bb 100644 --- a/R/normalize_with_base.R +++ b/R/normalize_with_base.R @@ -1,13 +1,18 @@ #' Normalize a Path with Respect to a Base Directory #' -#' This function normalizes a given path with respect to a specified base directory. -#' If the path is relative, it combines the base directory and the path, then normalizes the resulting path. +#' This function normalizes a given path with respect to a specified base +#' directory. +#' If the path is relative, it combines the base directory and the path, then +#' normalizes the resulting path. #' If the path is absolute or starts with `~`, it normalizes the path directly. -#' If no base directory is specified, the current working directory is used as the base. +#' If no base directory is specified, the current working directory is used as +#' the base. #' -#' @param path A character string representing the path to be normalized. Can be relative, absolute, or start with `~`. -#' @param base A character string representing the base directory with respect to which the path should be normalized. -#' The default is the current working directory ("."). +#' @param path A character string representing the path to be normalized. +#' Can be relative, absolute, or start with `~`. +#' @param base A character string representing the base directory with respect +#' to which the path should be normalized. The default is the current working +#' directory ("."). #' @return A character string representing the normalized path. #' @examples #' \dontrun{ diff --git a/R/options.R b/R/options.R index 5363f10..bde1593 100644 --- a/R/options.R +++ b/R/options.R @@ -11,13 +11,15 @@ NULL options::define_option( option = "out_formats", default = "html", - desc = "Which log format(s) to produce. Possiblities are `html`, `json`, and markdown formats:`gfm`, `commonmark`, and `markua`." + desc = "Which log format(s) to produce. Possiblities are `html`, `json`, and + markdown formats: `gfm`, `commonmark`, and `markua`." ) options::define_option( option = "track_files", default = FALSE, - desc = "Should files read and written be tracked? Currently only supported on Linux.", + desc = "Should files read and written be tracked? + Currently only supported on Linux.", envvar_fn = options::envvar_is_true() ) @@ -43,7 +45,6 @@ options::define_option( "^/null", "^/urandom", "^/.cache", - # "^/renv"#, .libPaths() ), desc = "List of file naming patterns not be tracked when track_files = TRUE", @@ -53,14 +54,16 @@ options::define_option( options::define_option( option = "track_files_keep", default = paste0("^", getwd()), - desc = "List of file naming patterns alway to be tracked when track_files = TRUE", + desc = "List of file naming patterns alway to be tracked when + track_files = TRUE", envvar_fn = options::envvar_str_split(delim = ";") ) options::define_option( option = "verbosity_level", default = "verbose", - desc = "How chatty should the log be? Possibilities are `quiet`, `minimal` and `verbose`." + desc = "How chatty should the log be? Possibilities are + `quiet`, `minimal` and `verbose`." ) options::define_option( @@ -80,17 +83,25 @@ options::define_option( options::define_option( option = "n_workers", default = 1, - desc = "Number of simultanous workers used in the run function. A maximum of 128 workers is allowed." + desc = "Number of simultanous workers used in the run function. + A maximum of 128 workers is allowed." ) options::define_option( option = "log_dir", default = dirname, - desc = "The output directory of the log files. Default is the folder of the excuted script. log_dir can be a path as a character or it can be a function that takes the script path as input and returns the log directory. For more information see the examples of `run()` or `vignette('whirl')`." + desc = "The output directory of the log files. Default is the folder of the + excuted script. log_dir can be a path as a character or it can be a function + that takes the script path as input and returns the log directory. + For more information see the examples of `run()` or `vignette('whirl')`." ) options::define_option( option = "execute_dir", default = NULL, - desc = "The working directory of the process executing each script. Defeault us to execute R files from the working directory when calling `run()` and all other functions from the directory of the script. To change provide a character path (used for all scripts) or a function that takes the script as input and returns the execution directory." + desc = "The working directory of the process executing each script. + Defeault us to execute R files from the working directory when calling `run()` + and all other functions from the directory of the script. To change provide + a character path (used for all scripts) or a function that takes the script + as input and returns the execution directory." ) diff --git a/R/pb_script.R b/R/pb_script.R index 219b9bc..0fdc1c0 100644 --- a/R/pb_script.R +++ b/R/pb_script.R @@ -4,7 +4,6 @@ pb_script <- R6::R6Class( classname = "pb_script", public = list( initialize = \(script, use_progress = cli::is_dynamic_tty()) { - withr::local_options( cli.progress_show_after = 0, cli.progress_clear = FALSE @@ -25,13 +24,13 @@ pb_script <- R6::R6Class( ), format = paste0( "{cli::pb_spin} ", - "{.href [{basename(cli::pb_extra$script)}](file://{cli::pb_extra$script})}: ", + "{.href [{basename(cli::pb_extra$script)}](file://{cli::pb_extra$script})}: ", # nolint "{cli::pb_status}", "[{cli::pb_elapsed}]" ), format_done = paste0( "{cli::pb_extra$done} ", - "{.href [{basename(cli::pb_extra$script)}](file://{cli::pb_extra$script})}: ", + "{.href [{basename(cli::pb_extra$script)}](file://{cli::pb_extra$script})}: ", # nolint "{cli::pb_status}", "[{cli::pb_elapsed}]" ) @@ -39,19 +38,17 @@ pb_script <- R6::R6Class( self$update() } }, - update = \(...){ + update = \(...) { if (!is.null(private$id)) cli::cli_progress_update(id = private$id, ...) }, - done = \(status = c("success", "warning", "error")){ + done = \(status = c("success", "warning", "error")) { status <- rlang::arg_match(status) - done <- switch( - status, + done <- switch(status, success = cli::col_green(cli::symbol$tick), warning = cli::col_yellow(cli::symbol$warning), error = cli::col_red(cli::symbol$cross) ) - done_msg <- switch( - status, + done_msg <- switch(status, success = "Completed succesfully", warning = "Completed with warnings", error = "Completed with errors" diff --git a/R/quarto.R b/R/quarto.R index 17e9720..da8436f 100644 --- a/R/quarto.R +++ b/R/quarto.R @@ -8,9 +8,11 @@ #' @param collapse description #' @noRd -quarto_callout <- function(text = NULL, title = NULL, - type = c("note", "warning", "important", "tip", "caution"), - collapse = NULL) { +quarto_callout <- function( + text = NULL, + title = NULL, + type = c("note", "warning", "important", "tip", "caution"), + collapse = NULL) { type <- rlang::arg_match(type) if (!is.null(collapse)) { collapse <- ifelse(collapse, "true", "false") diff --git a/R/read_glob.R b/R/read_glob.R index 71781e5..bb2dda0 100644 --- a/R/read_glob.R +++ b/R/read_glob.R @@ -7,11 +7,11 @@ read_glob <- function(input) { files_ <- lapply(input, function(x) { - #If the file exist then return the path + # If the file exist then return the path if (file.exists(x)) { return(x) } else { - #If the file does not exist then check if it is a glob + # If the file does not exist then check if it is a glob files <- Sys.glob(x) if (length(files) == 0) { cli::cli_alert_warning("No files or folders for this path {x}") @@ -23,5 +23,3 @@ read_glob <- function(input) { return(files_) } - - diff --git a/R/render_summary.R b/R/render_summary.R index 1545a09..baa85bd 100644 --- a/R/render_summary.R +++ b/R/render_summary.R @@ -1,12 +1,13 @@ #' Render dataframe into a summary.html file #' -#' @param input The input data.frame that should be rendered into a summary.html file -#' @param summary_file A character string specifying the path where the summary HTML file should be saved. Defaults to `"summary.html"`. +#' @param input The input data.frame that should be rendered into a summary.html +#' file +#' @param summary_file A character string specifying the path where the summary +#' HTML file should be saved. Defaults to `"summary.html"`. #' #' @return Takes a dataframe as input and returns a log in html format #' @noRd render_summary <- function(input, summary_file = "summary.html") { - summary_qmd <- withr::local_tempfile( lines = readLines(system.file("documents/summary.qmd", package = "whirl")), fileext = ".qmd" @@ -28,7 +29,7 @@ render_summary <- function(input, summary_file = "summary.html") { ) # Create requested outputs - file_copy <- tryCatch( + tryCatch( file.copy( from = summary_log_html, to = summary_file, @@ -57,7 +58,10 @@ knit_print.whirl_summary_info <- function(x, path_rel_start, ...) { file.path() } - hold$Hyperlink <- paste0(sprintf('%s', formatted, "HTML Log")) + hold$Hyperlink <- paste0(sprintf( + '%s', + formatted, "HTML Log" + )) knitr::kable(hold, format = "html", escape = FALSE) |> kableExtra::column_spec(1:ncols, background = ifelse( @@ -67,10 +71,13 @@ knit_print.whirl_summary_info <- function(x, path_rel_start, ...) { hold[["Status"]] == "warning", "#fffaea", ifelse(hold[["Status"]] == "success", "#ebf5f1", - ifelse(hold[["Status"]] == "skip", "#94CBFF", "white") + ifelse(hold[["Status"]] == "skip", "#94CBFF", "white") ) ) )) |> - kableExtra::kable_styling(bootstrap_options = "striped", full_width = TRUE) |> + kableExtra::kable_styling( + bootstrap_options = "striped", + full_width = TRUE + ) |> knitr::knit_print() } diff --git a/R/renv.R b/R/renv.R index c44a014..0c6b825 100644 --- a/R/renv.R +++ b/R/renv.R @@ -50,7 +50,8 @@ knit_print.whirl_renv_status <- function(x, ...) { ) } -#' Format renv message with markdown table. Used when packages are in inconsistent state only. +#' Format renv message with markdown table. +#' Used when packages are in inconsistent state only. #' @noRd renv_message_table <- function(renv_message) { @@ -61,7 +62,12 @@ renv_message_table <- function(renv_message) { return(renv_message) } - renv_message[i] <- gsub(pattern = "( |$)(?! )", replacement = "|", x = renv_message[i], perl = TRUE) + renv_message[i] <- gsub( + pattern = "( |$)(?! )", + replacement = "|", + x = renv_message[i], + perl = TRUE + ) j <- i[[1]] diff --git a/R/run.R b/R/run.R index 7fa4abe..9895478 100644 --- a/R/run.R +++ b/R/run.R @@ -22,12 +22,14 @@ #' @return A tibble containing the execution results for all the scripts. #' -#'@examples +#' @examples #' # Start by copying the following three example scripts: #' file.copy( -#' from = system.file("examples", c("success.R", "warning.R", "error.R"), package = "whirl"), +#' from = system.file("examples", c("success.R", "warning.R", "error.R"), +#' package = "whirl" +#' ), #' to = "." -#' ) +#' ) #' #' # Run a single script #' run("success.R") @@ -40,101 +42,108 @@ #' list( #' c("success.R", "warning.R"), #' "error.R" -#' ), -#' n_workers = 2) +#' ), +#' n_workers = 2 +#' ) #' #' @examplesIf FALSE #' #' # Re-directing the logs to a sub-folder by utilizing the log_dir argument in -#' # run(). This will require that the sub-folder exist and the code is therefore -#' # not executed +#' # run(). This will require that the sub-folder exist and the code is +#' # therefore not executed #' #' # Specifying the path using a manually defined character #' run("success.R", log_dir = getwd()) #' #' # Specifying the path with a generic function that can handle the scripts #' # individually. -#' run("success.R", log_dir = function(x) {paste0(dirname(x), "/logs")}) +#' run("success.R", log_dir = function(x) { +#' paste0(dirname(x), "/logs") +#' }) #' #' @export -run <- function(input, - steps = NULL, - summary_file = "summary.html", - n_workers = options::opt("n_workers", env = "whirl"), - check_renv = options::opt("check_renv", env = "whirl"), - verbosity_level = options::opt("verbosity_level", env = "whirl"), - track_files = options::opt("track_files", env = "whirl"), - out_formats = options::opt("out_formats", env = "whirl"), - log_dir = options::opt("log_dir", env = "whirl") - ) { - +run <- function( + input, + steps = NULL, + summary_file = "summary.html", + n_workers = options::opt("n_workers", env = "whirl"), + check_renv = options::opt("check_renv", env = "whirl"), + verbosity_level = options::opt("verbosity_level", env = "whirl"), + track_files = options::opt("track_files", env = "whirl"), + out_formats = options::opt("out_formats", env = "whirl"), + log_dir = options::opt("log_dir", env = "whirl")) { # Additional Settings - track_files_discards = options::opt("track_files_discards", env = "whirl") - track_files_keep = options::opt("track_files_keep", env = "whirl") - approved_pkgs_folder = options::opt("approved_pkgs_folder", env = "whirl") - approved_pkgs_url = options::opt("approved_pkgs_url", env = "whirl") + track_files_discards <- options::opt("track_files_discards", env = "whirl") + track_files_keep <- options::opt("track_files_keep", env = "whirl") + approved_pkgs_folder <- options::opt("approved_pkgs_folder", env = "whirl") + approved_pkgs_url <- options::opt("approved_pkgs_url", env = "whirl") # Message when initiating d <- NULL - zephyr::msg(message = "Executing scripts and generating logs", - theme = list( - rule = list(color = "skyblue3", "line-type" = "double") - ), - levels_to_write = c("verbose"), - verbosity_level = verbosity_level, - msg_fun = \(message, theme, .envir) { - d <<- cli::cli_div(theme = theme, .auto_close = FALSE) - cli::cli_rule(message, .envir = .envir) - } + zephyr::msg( + message = "Executing scripts and generating logs", + theme = list( + rule = list(color = "skyblue3", "line-type" = "double") + ), + levels_to_write = c("verbose"), + verbosity_level = verbosity_level, + msg_fun = \(message, theme, .envir) { + d <<- cli::cli_div(theme = theme, .auto_close = FALSE) + cli::cli_rule(message, .envir = .envir) + } ) # Message when ending on.exit({ - zephyr::msg(message = "End of process", - div = d, - levels_to_write = c("verbose"), - verbosity_level = verbosity_level, - msg_fun = \(message, div, .envir) { - cli::cli_rule(message, .envir = .envir) - cli::cli_end(div) - } - ) + zephyr::msg( + message = "End of process", + div = d, + levels_to_write = c("verbose"), + verbosity_level = verbosity_level, + msg_fun = \(message, div, .envir) { + cli::cli_rule(message, .envir = .envir) + cli::cli_end(div) + } + ) }) # Constrain the number of workers n_workers <- min(128, n_workers) zephyr::msg("Executing scripts in parallel using {n_workers} cores\n", - levels_to_write = "verbose", - verbosity_level = verbosity_level, - msg_fun = cli::cli_inform) + levels_to_write = "verbose", + verbosity_level = verbosity_level, + msg_fun = cli::cli_inform + ) # Initiating the queue - queue <- whirl_queue$new(n_workers = n_workers, - check_renv = check_renv, - verbosity_level = verbosity_level, - track_files = track_files, - out_formats = out_formats, - track_files_discards = track_files_discards, - track_files_keep = track_files_keep, - approved_pkgs_folder = approved_pkgs_folder, - approved_pkgs_url = approved_pkgs_url, - log_dir = log_dir) + queue <- whirl_queue$new( + n_workers = n_workers, + check_renv = check_renv, + verbosity_level = verbosity_level, + track_files = track_files, + out_formats = out_formats, + track_files_discards = track_files_discards, + track_files_keep = track_files_keep, + approved_pkgs_folder = approved_pkgs_folder, + approved_pkgs_url = approved_pkgs_url, + log_dir = log_dir + ) - result <- internal_run(input = input, - steps = steps, - queue = queue, - level = 1, - verbosity_level = verbosity_level) + result <- internal_run( + input = input, + steps = steps, + queue = queue, + level = 1, + verbosity_level = verbosity_level + ) # Create the summary log if required if (!is.null(summary_file)) { summary_tibble <- util_queue_summary(result$queue) render_summary(input = summary_tibble, summary_file = summary_file) - } invisible(result$queue) - } diff --git a/R/session.R b/R/session.R index 1304dc2..997e34f 100644 --- a/R/session.R +++ b/R/session.R @@ -5,10 +5,12 @@ #' #' @noRd -session_info <- function(approved_folder_pkgs = NULL, approved_url_pkgs = NULL, python_packages = NULL) { +session_info <- function(approved_folder_pkgs = NULL, + approved_url_pkgs = NULL, + python_packages = NULL) { info <- sessioninfo::session_info() - if (!is.null(approved_folder_pkgs) | + if (!is.null(approved_folder_pkgs) || !is.null(approved_url_pkgs)) { info$packages <- check_approved( approved_pkg_folder = approved_folder_pkgs, @@ -32,7 +34,8 @@ session_info <- function(approved_folder_pkgs = NULL, approved_url_pkgs = NULL, class(info$options) <- c("options_info", class(info$options)) # TODO: Extend to also cover external. - info[!names(info) %in% c("platform", "packages", "environment", "options")] <- NULL + info[!names(info) %in% c("platform", "packages", "environment", "options")] <- + NULL if (is.null(info$platform$quarto)) { quarto_path <- Sys.getenv("QUARTO_PATH") @@ -41,16 +44,23 @@ session_info <- function(approved_folder_pkgs = NULL, approved_url_pkgs = NULL, if (nzchar(quarto_path)) { quarto_version <- system2(quarto_path, "--version", stdout = TRUE) - info$platform$quarto <- paste(quarto_version, "@", normalizePath(quarto_path, winslash = "/")) + info$platform$quarto <- paste( + quarto_version, "@", + normalizePath(quarto_path, winslash = "/") + ) } } if (!is.null(python_packages)) { - # TODO: Get the same information as for R packages (not only name and version) + # TODO: Get the same information as for R packages + # (not only name and version) # TODO: Only show used, and not all installed, packages if possible info$python_packages <- python_packages - class(info$python_packages) <- c("packages_info", class(info$python_packages)) + class(info$python_packages) <- c( + "packages_info", + class(info$python_packages) + ) info$platform$python <- reticulate::py_config()[["version"]] |> as.character() |> @@ -59,7 +69,10 @@ session_info <- function(approved_folder_pkgs = NULL, approved_url_pkgs = NULL, class(info) <- c("whirl_session_info", class(info)) for (i in seq_along(info)) { - class(info[[i]]) <- c(paste0("whirl_", class(info[[i]])[[1]]), class(info[[i]])) + class(info[[i]]) <- c( + paste0("whirl_", class(info[[i]])[[1]]), + class(info[[i]]) + ) } return(info) @@ -164,7 +177,19 @@ knit_print.whirl_approved_pkgs <- function(x, ...) { bootstrap_options = "striped", full_width = TRUE ) |> - kableExtra::column_spec(1:ncols, background = ifelse(as.integer(rowSums(as.matrix(hold[, grepl("^Approved", colnames(hold))]) == "No") == ncol(as.matrix(hold[, grepl("^Approved", colnames(hold))]))) == 1, "orange", "white")) |> + kableExtra::column_spec( + column = 1:ncols, + background = ifelse( + as.integer( + rowSums( + as.matrix(hold[, grepl("^Approved", colnames(hold))]) == "No" + ) == + ncol(as.matrix(hold[, grepl("^Approved", colnames(hold))])) + ) == 1, + "orange", + "white" + ) + ) |> knitr::knit_print() } @@ -176,8 +201,13 @@ insert_at_intervals_df <- function(df, column_name, char_to_insert, interval) { } else { result <- input_string insert_positions <- seq(interval, nchar(input_string), by = interval) - for (i in length(insert_positions):1) { - result <- paste(substr(result, 1, insert_positions[i] - 1), char_to_insert, substr(result, insert_positions[i], nchar(result)), sep = "") + for (i in rev(seq_along(insert_positions))) { + result <- paste( + substr(result, 1, insert_positions[i] - 1), + char_to_insert, + substr(result, insert_positions[i], nchar(result)), + sep = "" + ) } return(result) } diff --git a/R/status.R b/R/status.R index 2cd5aa6..ef01f03 100644 --- a/R/status.R +++ b/R/status.R @@ -1,6 +1,7 @@ #' Get execution status #' -#' Retrieves errors and warnings from the generated markdown file, and derives the execution status. +#' Retrieves errors and warnings from the generated markdown file, +#' and derives the execution status. #' #' @noRd @@ -18,7 +19,9 @@ get_status <- function(md) { # Errors errors <- x |> - stringr::str_subset(pattern = "^ *\\{\\.cell-output \\.cell-output-error\\}") |> + stringr::str_subset( + pattern = "^ *\\{\\.cell-output \\.cell-output-error\\}" + ) |> stringr::str_remove_all("\\{[^\\}]*\\}") |> stringr::str_squish() @@ -35,7 +38,9 @@ get_status <- function(md) { # Warnings warnings <- x |> - stringr::str_subset(pattern = "^ *\\{\\.cell-output \\.cell-output-stderr\\}") |> + stringr::str_subset( + pattern = "^ *\\{\\.cell-output \\.cell-output-stderr\\}" + ) |> stringr::str_remove_all("\\{[^\\}]*\\}") |> stringr::str_squish() |> stringr::str_subset(pattern = "^(W|w)arning") diff --git a/R/strace.R b/R/strace.R index de9a4f3..3dc5fb5 100644 --- a/R/strace.R +++ b/R/strace.R @@ -5,7 +5,6 @@ start_strace <- function(pid, file) { sprintf( - # "strace -f -q -ttt -T -e trace=openat,unlink,unlinkat,chdir,network -o %s -p %s -y", "strace -f -q -ttt -T -e trace=all -s 256 -o %s -p %s -y", file, pid @@ -16,13 +15,20 @@ start_strace <- function(pid, file) { #' Get strace info ready for reporting #' #' @param path [character] path to the strace log -#' @param p_wd [character] path to the working directory used for the process tracked in strace -#' @param strace_discards [character] keywords to use to discard files from the info -#' @param types [character] which element(s) to report in the info. If not found in strace, a dummy `data.frame` is inserted. +#' @param p_wd [character] path to the working directory used for the process +#' tracked in strace +#' @param strace_discards [character] keywords to use to discard files from +#' the info +#' @param types [character] which element(s) to report in the info. If not +#' found in strace, a dummy `data.frame` is inserted. #' @return [list] of `data.frame`(s) of the relevant files for each type of info #' @noRd -read_strace_info <- function(path, p_wd = dirname(path), strace_discards = character(), strace_keep = character(), types = c("read", "write", "delete")) { +read_strace_info <- function(path, + p_wd = dirname(path), + strace_discards = character(), + strace_keep = character(), + types = c("read", "write", "delete")) { strace <- path |> read_strace(p_wd = p_wd) |> refine_strace(strace_discards = strace_discards, strace_keep = strace_keep) @@ -53,12 +59,13 @@ read_strace_info <- function(path, p_wd = dirname(path), strace_discards = chara #' Read strace file #' #' @param path [character] path to the strace log -#' @param p_wd [character] path to the working directory used for the process tracked in strace -#' @return [data.frame] with strace information where all files are reported with their full path +#' @param p_wd [character] path to the working directory used for the process +#' tracked in strace +#' @return [data.frame] with strace information where all files are reported +#' with their full path #' @noRd read_strace <- function(path, p_wd) { - # Early return if file does not exist if (!file.exists(path)) { @@ -78,10 +85,12 @@ read_strace <- function(path, p_wd) { stringr::str_squish() |> stringr::str_subset("openat|unlink|chdir") |> stringr::str_subset( - pattern = "ENOENT \\(No such file or directory\\)|ENXIO \\(No such device or address\\)| ENOTDIR \\(Not a directory\\)", + pattern = "ENOENT \\(No such file or directory\\)|ENXIO \\(No such device or address\\)| ENOTDIR \\(Not a directory\\)", # nolint negate = TRUE ) |> - stringr::str_subset("|<\\.{3} [a-zA-Z]+ resumed>", negate = TRUE) + stringr::str_subset("|<\\.{3} [a-zA-Z]+ resumed>", + negate = TRUE + ) # Early return if no information @@ -101,10 +110,10 @@ read_strace <- function(path, p_wd) { strace_df <- strace |> unglue::unglue_data( patterns = list( - "{pid} {time} {funct}({keyword}<{dir}>, \"{path}\", {action}, {access}) = {result}<{result_dir}> <{duration}>", - "{pid} {time} {funct}({keyword}<{dir}>, \"{path}\", {action}) = {result}<{result_dir}> <{duration}>", - "{pid} {time} {funct}({keyword}<{dir}>, \"{path}\", {action}) = {result} <{duration}>", - "{pid} {time} {funct}(\"{path}\") = {result} <{duration}>" + "{pid} {time} {funct}({keyword}<{dir}>, \"{path}\", {action}, {access}) = {result}<{result_dir}> <{duration}>", # nolint + "{pid} {time} {funct}({keyword}<{dir}>, \"{path}\", {action}) = {result}<{result_dir}> <{duration}>", # nolint + "{pid} {time} {funct}({keyword}<{dir}>, \"{path}\", {action}) = {result} <{duration}>", # nolint + "{pid} {time} {funct}(\"{path}\") = {result} <{duration}>" # nolint ) ) |> tibble::as_tibble() |> @@ -117,7 +126,8 @@ read_strace <- function(path, p_wd) { type = dplyr::case_when( .data$funct == "chdir" ~ "chdir", stringr::str_detect(.data$funct, "unlink") ~ "delete", - .data$funct == "openat" & stringr::str_detect(.data$action, "O_DIRECTORY") ~ "lookup", + .data$funct == "openat" & + stringr::str_detect(.data$action, "O_DIRECTORY") ~ "lookup", .data$funct == "openat" & is.na(.data$access) ~ "read", .data$funct == "openat" & !is.na(.data$access) ~ "write", ), @@ -146,15 +156,20 @@ read_strace <- function(path, p_wd) { #' refine strace output #' -#' @param strace_df [data.frame] with strace information as returned from `read_strace` -#' @param strace_discards [character] keywords to use to discard files from the info -#' @return [data.frame] with strace information where discarded and duplicate files are removed +#' @param strace_df [data.frame] with strace information as returned from +#' `read_strace` +#' @param strace_discards [character] keywords to use to discard files from the +#' info +#' @return [data.frame] with strace information where discarded and duplicate +#' files are removed #' @noRd -refine_strace <- function(strace_df, strace_discards = character(), strace_keep = character()) { +refine_strace <- function(strace_df, + strace_discards = character(), + strace_keep = character()) { # Remove discards if provided - if (length(strace_discards) & length(strace_keep)) { + if (length(strace_discards) && length(strace_keep)) { strace_df <- strace_df |> dplyr::filter( stringr::str_detect( @@ -182,15 +197,24 @@ refine_strace <- function(strace_df, strace_discards = character(), strace_keep strace_df |> dplyr::filter( - .data$type %in% c("read", "write") & !duplicated(strace_df[c("file", "type")]) | # First read or write - .data$type %in% c("delete") & !duplicated(strace_df[c("file", "type")], fromLast = TRUE) # Last delete + # First read or write + .data$type %in% c("read", "write") & + !duplicated(strace_df[c("file", "type")]) | + # Last delete + .data$type %in% c("delete") & + !duplicated(strace_df[c("file", "type")], fromLast = TRUE) ) |> dplyr::group_by(.data$file) |> dplyr::arrange(.data$file, .data$seq) |> dplyr::filter( - .data$type == "read" & !cumsum(.data$type == "write") | # Remove reads from a file created earlier - .data$type == "write" & !cumsum(rev(.data$type) == "delete") | # Remove write when the file is deleted afterwards - .data$type == "delete" & (!cumsum(.data$type == "write") | utils::head(.data$type, 1) == "read") # Remove delete when the file was created earlier, and not read before that creation + # Remove reads from a file created earlier + .data$type == "read" & !cumsum(.data$type == "write") | + # Remove write when the file is deleted afterwards + .data$type == "write" & !cumsum(rev(.data$type) == "delete") | + # Remove delete when the file was created earlier, and not read before + # that creation + .data$type == "delete" & + (!cumsum(.data$type == "write") | utils::head(.data$type, 1) == "read") ) |> dplyr::ungroup() |> dplyr::arrange(.data$seq, .data$file) |> diff --git a/R/use_whirl.R b/R/use_whirl.R index 448dfdc..8da8823 100644 --- a/R/use_whirl.R +++ b/R/use_whirl.R @@ -7,7 +7,8 @@ #' 1. Creates configuration file (default `_whirl.yaml`) #' 1. Updates `.gitignore` to not include log files #' -#' See `vignette("whirl")` for how to specify paths inside the configuration file. +#' See `vignette("whirl")` for how to specify paths inside the +#' configuration file. #' #' @param config_file Path to the whirl config file, relative to the project #' @export diff --git a/R/util_queue_summary.R b/R/util_queue_summary.R index 475c0fd..a98eecc 100644 --- a/R/util_queue_summary.R +++ b/R/util_queue_summary.R @@ -8,7 +8,7 @@ #' @noRd util_queue_summary <- function(queue_table) { if (!"result" %in% names(queue_table) || - !is.list(queue_table$result)) { + !is.list(queue_table$result)) { stop("queue_table must contain a list named 'result'") } @@ -39,5 +39,4 @@ util_queue_summary <- function(queue_table) { ) |> tidyr::unnest(cols = c("Information"), keep_empty = TRUE) |> tidyr::replace_na(list(Information = "")) - } diff --git a/R/utils.R b/R/utils.R index 703d730..99fe880 100644 --- a/R/utils.R +++ b/R/utils.R @@ -5,7 +5,11 @@ get_file_ext <- function(file_paths) { FUN = function(file_path) { file_name <- basename(file_path) file_parts <- strsplit(file_name, "\\.")[[1]] - file_extension <- ifelse(length(file_parts) == 1, "", utils::tail(file_parts, 1)) + file_extension <- ifelse( + length(file_parts) == 1, + "", + utils::tail(file_parts, 1) + ) return(file_extension) }, FUN.VALUE = character(1), @@ -16,7 +20,10 @@ get_file_ext <- function(file_paths) { # Function to scale a numeric vector to percentage scale_to_percent <- function(x, digits = 2) { percent_values <- x * 100 - formatted_percent_values <- sprintf(paste0("%.", digits, "f%%"), percent_values) + formatted_percent_values <- sprintf( + fmt = paste0("%.", digits, "f%%"), + percent_values + ) return(formatted_percent_values) } diff --git a/R/whirl_queue.R b/R/whirl_queue.R index 96d7549..44276ac 100644 --- a/R/whirl_queue.R +++ b/R/whirl_queue.R @@ -2,8 +2,8 @@ #' @description #' Implementation of a queue for supporting the continuous execution and logging #' of several scripts. -#' The queue can be used interactively, but is mainly designed to be the internal -#' backbone of the `run()` function. +#' The queue can be used interactively, but is mainly designed to be the +#' internal backbone of the `run()` function. #' When a queue has several workers, pushed scripts will be run in parallel. #' @importFrom R6 R6Class #' @noRd @@ -16,47 +16,58 @@ whirl_queue <- R6::R6Class( #' @description Initialize the new whirl_queue #' @return A [whirl_queue] object initialize = \(n_workers = options::opt("n_workers", env = "whirl"), - verbosity_level = options::opt("verbosity_level", env = "whirl"), - check_renv = options::opt("check_renv", env = "whirl"), - track_files = options::opt("track_files", env = "whirl"), - out_formats = options::opt("out_formats", env = "whirl"), - track_files_discards = options::opt("track_files_discards", env = "whirl"), - track_files_keep = options::opt("track_files_keep", env = "whirl"), - approved_pkgs_folder = options::opt("approved_pkgs_folder", env = "whirl"), - approved_pkgs_url = options::opt("approved_pkgs_url", env = "whirl"), - log_dir = options::opt("log_dir", env = "whirl") - ) { - wq_initialise(self, private, - n_workers, - verbosity_level, - check_renv, - track_files, - out_formats, - track_files_discards, - track_files_keep, - approved_pkgs_folder, - approved_pkgs_url, - log_dir) + verbosity_level = options::opt("verbosity_level", env = "whirl"), + check_renv = options::opt("check_renv", env = "whirl"), + track_files = options::opt("track_files", env = "whirl"), + out_formats = options::opt("out_formats", env = "whirl"), + track_files_discards = options::opt("track_files_discards", + env = "whirl" + ), + track_files_keep = options::opt("track_files_keep", env = "whirl"), + approved_pkgs_folder = options::opt("approved_pkgs_folder", + env = "whirl" + ), + approved_pkgs_url = options::opt("approved_pkgs_url", env = "whirl"), + log_dir = options::opt("log_dir", env = "whirl") + ) { + wq_initialise( + self, private, + n_workers, + verbosity_level, + check_renv, + track_files, + out_formats, + track_files_discards, + track_files_keep, + approved_pkgs_folder, + approved_pkgs_url, + log_dir + ) }, #' @description Push scripts to the queue #' @param scripts [character] Full paths for the scripts to be executed - #' @param tag (optional) [character] Tag for the scripts to include in the queue + #' @param tag (optional) [character] Tag for the scripts to include in + #' the queue #' @return [invisible] self push = \(scripts, tag = NA_character_) { wq_push(self, private, scripts, tag) }, - #' @description Push scripts in the queue without executing them. Utility to include skipped scripts in the final queue. + #' @description Push scripts in the queue without executing them. + #' Utility to include skipped scripts in the final queue. #' @param scripts [character] Full paths for the scripts to be executed - #' @param tag (optional) [character] Tag for the scripts to include in the queue + #' @param tag (optional) [character] Tag for the scripts to include in + #' the queue #' @return [invisible] self skip = \(scripts, tag = NA_character_) { wq_skip(self, private, scripts, tag) }, #' @description Poll the queue and start next steps if needed - #' @param timeout [numeric] The timeout in milliseconds. Note it is only implemented approximately if more than one script is running simultaneously. + #' @param timeout [numeric] The timeout in milliseconds. + #' Note it is only implemented approximately if more than one script is + #' running simultaneously. #' @return [character] Status of all scripts queue poll = \(timeout) { wq_poll(self, private, timeout) @@ -69,8 +80,9 @@ whirl_queue <- R6::R6Class( wq_wait(self, private, timeout) }, - #' @description Run scripts using the queue. This is a wrapper around calling both push() and wait(). - #' @param scripts [character] with full paths for the scripts to be executed. + #' @description Run scripts using the queue. + #' This is a wrapper around calling both push() and wait(). + #' @param scripts [character] with full paths for the scripts to be executed #' @return [invisible] self run = \(scripts) { wq_run(scripts, self) @@ -83,7 +95,6 @@ whirl_queue <- R6::R6Class( return(invisible(self)) } ), - active = list( #' @field queue [tibble] Current status of the queue queue = \() { @@ -112,7 +123,6 @@ whirl_queue <- R6::R6Class( head(length(self$next_ids)) } ), - private = list( .queue = NULL, .workers = NULL, @@ -133,7 +143,6 @@ wq_initialise <- function(self, private, n_workers, verbosity_level, check_renv, track_files, out_formats, track_files_discards, track_files_keep, approved_pkgs_folder, approved_pkgs_url, log_dir) { - private$check_renv <- check_renv private$verbosity_level <- verbosity_level private$track_files <- track_files @@ -163,22 +172,19 @@ wq_initialise <- function(self, private, n_workers, } wq_add_queue <- function(self, private, scripts, tag, status) { - - #Adding the log directory to the queue + # Adding the log directory to the queue if (is.character(private$log_dir)) { - #Check if the directory exists + # Check if the directory exists if (!file.exists(private$log_dir)) { cli::cli_abort("Logs cannot be saved because {.val {private$log_dir}} does not exist") } folder <- file.path(private$log_dir) - } else { - folder <- private$log_dir(scripts) - #Check if the directory exists + # Check if the directory exists unique_folders <- unique(folder) if (any(!file.exists(unique_folders))) { - missing <- unique_folders[!file.exists(unique_folders)] + missing <- unique_folders[!file.exists(unique_folders)] # nolint cli::cli_abort("Logs cannot be saved because {.val {missing}} does not exist") } } @@ -206,24 +212,27 @@ wq_poll <- function(self, private, timeout, check_renv, verbosity_level, track_files, out_formats, track_files_discards, track_files_keep, approved_pkgs_folder, approved_pkgs_url, log_dir) { - - # Start new sessions if there are available workers and waiting scripts in the queue + # Start new sessions if there are available workers and waiting scripts in + # the queue if (length(self$next_ids)) { nid <- self$next_ids wid <- self$next_workers private$.workers[["session"]][wid] <- replicate( n = length(wid), - expr = whirl_r_session$new(check_renv = private$check_renv, - verbosity_level = private$verbosity_level, - track_files = private$track_files, - out_formats = private$out_formats, - track_files_discards = private$track_files_discards, - track_files_keep = private$track_files_keep, - approved_pkgs_folder = private$approved_pkgs_folder, - approved_pkgs_url = private$approved_pkgs_url, - log_dir = private$log_dir), - simplify = FALSE) + expr = whirl_r_session$new( + check_renv = private$check_renv, + verbosity_level = private$verbosity_level, + track_files = private$track_files, + out_formats = private$out_formats, + track_files_discards = private$track_files_discards, + track_files_keep = private$track_files_keep, + approved_pkgs_folder = private$approved_pkgs_folder, + approved_pkgs_url = private$approved_pkgs_url, + log_dir = private$log_dir + ), + simplify = FALSE + ) private$.workers[wid, "id_script"] <- nid private$.workers[wid, "active"] <- TRUE private$.queue[nid, "status"] <- "running" @@ -233,7 +242,7 @@ wq_poll <- function(self, private, timeout, # When completed the session is stopped and the status in the queue is updated i_active <- which(private$.workers$active) - i_timeout <- round(timeout/length(i_active)) + i_timeout <- round(timeout / length(i_active)) for (i in i_active) { p <- private$.workers$session[[i]]$poll(timeout = i_timeout) if (p == "ready") private$.workers$session[[i]]$read() @@ -252,44 +261,49 @@ wq_wait <- function(self, private, timeout) { while (go) { self$poll(50) go <- any(self$queue$status %in% c("waiting", "running")) - if (timeout >= 0 && difftime(Sys.time(), start, units = "secs") > timeout) break + if (timeout >= 0 && difftime(Sys.time(), start, units = "secs") > timeout) { + break + } } return(invisible(self)) } wq_next_step <- function(self, private, wid) { - purrr::pluck(private$.workers, "step", wid) <- purrr::pluck(private$.workers, "step", wid) + 1 + purrr::pluck(private$.workers, "step", wid) <- + purrr::pluck(private$.workers, "step", wid) + 1 id_script <- purrr::pluck(private$.workers, "id_script", wid) session <- purrr::pluck(private$.workers, "session", wid) switch(EXPR = purrr::pluck(private$.workers, "step", wid), - # Step 1: Log script - "1" = { - script <- purrr::pluck(private$.queue, "script", id_script) - session$log_script(script) - }, - # Step 2: Create log - "2" = { - session$create_log() - }, - # Step 3: Finish log and create outputs - "3" = { - purrr::pluck(private$.queue, "result", id_script) <- session$ - log_finish()$ - create_outputs(out_dir = purrr::pluck(private$.queue, "log_dir", id_script), - format = private$out_formats) - - purrr::pluck(private$.queue, "status", id_script) <- - purrr::pluck(private$.queue, "result", id_script, "status", "status") - - session$finalize() - - purrr::pluck(private$.workers, "session", wid) <- NULL - purrr::pluck(private$.workers, "active", wid) <- FALSE - purrr::pluck(private$.workers, "id_script", wid) <- 0 - purrr::pluck(private$.workers, "step", wid) <- 0 - } + # Step 1: Log script + "1" = { + script <- purrr::pluck(private$.queue, "script", id_script) + session$log_script(script) + }, + # Step 2: Create log + "2" = { + session$create_log() + }, + # Step 3: Finish log and create outputs + "3" = { + purrr::pluck(private$.queue, "result", id_script) <- session$ + log_finish()$ + create_outputs( + out_dir = purrr::pluck(private$.queue, "log_dir", id_script), + format = private$out_formats + ) + + purrr::pluck(private$.queue, "status", id_script) <- + purrr::pluck(private$.queue, "result", id_script, "status", "status") + + session$finalize() + + purrr::pluck(private$.workers, "session", wid) <- NULL + purrr::pluck(private$.workers, "active", wid) <- FALSE + purrr::pluck(private$.workers, "id_script", wid) <- 0 + purrr::pluck(private$.workers, "step", wid) <- 0 + } ) return(invisible(wid)) diff --git a/R/whirl_r_session.R b/R/whirl_r_session.R index 212715c..11dc354 100644 --- a/R/whirl_r_session.R +++ b/R/whirl_r_session.R @@ -1,6 +1,7 @@ #' Whirl R session #' @description -#' Extension of [callr::r_session] with additional methods for easier creating logs. +#' Extension of [callr::r_session] with additional methods for easier creating +#' logs. #' @importFrom R6 R6Class #' @importFrom callr r_session #' @noRd @@ -12,26 +13,33 @@ whirl_r_session <- R6::R6Class( #' @description Initialize the new whirl R session #' @inheritParams options_params #' @return A [whirl_r_session] object - initialize = \(verbosity_level = options::opt("verbosity_level", env = "whirl"), - check_renv = options::opt("check_renv", env = "whirl"), - track_files = options::opt("track_files", env = "whirl"), - out_formats = options::opt("out_formats", env = "whirl"), - track_files_discards = options::opt("track_files_discards", env = "whirl"), - track_files_keep = options::opt("track_files_keep", env = "whirl"), - approved_pkgs_folder = options::opt("approved_pkgs_folder", env = "whirl"), - approved_pkgs_url = options::opt("approved_pkgs_url", env = "whirl"), - log_dir = options::opt("log_dir", env = "whirl") - ) { - wrs_initialize(verbosity_level, - check_renv, - track_files, - out_formats, - track_files_discards, - track_files_keep, - approved_pkgs_folder, - approved_pkgs_url, - log_dir, - self, private, super) + initialize = \( + verbosity_level = options::opt("verbosity_level", env = "whirl"), + check_renv = options::opt("check_renv", env = "whirl"), + track_files = options::opt("track_files", env = "whirl"), + out_formats = options::opt("out_formats", env = "whirl"), + track_files_discards = options::opt("track_files_discards", + env = "whirl" + ), + track_files_keep = options::opt("track_files_keep", env = "whirl"), + approved_pkgs_folder = options::opt("approved_pkgs_folder", + env = "whirl" + ), + approved_pkgs_url = options::opt("approved_pkgs_url", env = "whirl"), + log_dir = options::opt("log_dir", env = "whirl") + ) { + wrs_initialize( + verbosity_level, + check_renv, + track_files, + out_formats, + track_files_discards, + track_files_keep, + approved_pkgs_folder, + approved_pkgs_url, + log_dir, + self, private, super + ) }, #' @description Finalize the whirl R session @@ -102,7 +110,8 @@ whirl_r_session <- R6::R6Class( #' @param out_dir [character] Output directory for the log #' @param format [character] Output formats to create #' @return [invisible],[list] of logging information - create_outputs = \(out_dir, format = options::opt("out_formats", env = "whirl")) { + create_outputs = \(out_dir, + format = options::opt("out_formats", env = "whirl")) { wrs_create_outputs(out_dir, format, self, private, super) } ), @@ -127,10 +136,10 @@ wrs_initialize <- function(verbosity_level, check_renv, track_files, out_formats, track_files_discards, track_files_keep, approved_pkgs_folder, approved_pkgs_url, log_dir, self, private, super) { - super$initialize() # uses callr::r_session$initialize() - # TODO: Is there a way to use `.local_envir` to avoid having to clean up the temp dir in finalize? + # TODO: Is there a way to use `.local_envir` to avoid having to clean up the + # temp dir in finalize? private$wd <- withr::local_tempdir(clean = FALSE) private$verbosity_level <- verbosity_level private$check_renv <- check_renv @@ -142,7 +151,8 @@ wrs_initialize <- function(verbosity_level, check_renv, track_files, private$approved_pkgs_url <- approved_pkgs_url private$log_dir <- log_dir - # If the stream does not support dynamic tty, which is needed for progress bars to update in place, the verbosity is downgraded. + # If the stream does not support dynamic tty, which is needed for progress + # bars to update in place, the verbosity is downgraded. if (private$verbosity_level == "verbose" && !cli::is_dynamic_tty()) { private$verbosity_level <- "minimal" } @@ -153,8 +163,10 @@ wrs_initialize <- function(verbosity_level, check_renv, track_files, list.files(full.names = TRUE) |> file.copy(to = private$wd) - super$run(func = Sys.setenv, - args = list(WHIRL_LOG_MSG = file.path(private$wd,'log_msg.json'))) + super$run( + func = Sys.setenv, + args = list(WHIRL_LOG_MSG = file.path(private$wd, "log_msg.json")) + ) environment_file <- file.path(private$wd, "_environment") environment_file |> @@ -163,12 +175,15 @@ wrs_initialize <- function(verbosity_level, check_renv, track_files, writeLines(environment_file) if (track_files) { - start_strace(pid = super$get_pid(), file = file.path(private$wd, "strace.log")) + start_strace( + pid = super$get_pid(), + file = file.path(private$wd, "strace.log") + ) } } wrs_finalize <- function(self, private, super) { - super$run(func = setwd, args = list(dir = getwd())) # Needed for Windows to be able to delete the temp wd + super$run(func = setwd, args = list(dir = getwd())) unlink(private$wd, recursive = TRUE) super$finalize() } @@ -212,7 +227,9 @@ wrs_wait <- function(timeout, self, private, super) { go <- TRUE while (go) { go <- self$poll(timeout = 50) == "timeout" - if (timeout >= 0 && difftime(Sys.time(), start, units = "secs") > timeout) break + if (timeout >= 0 && difftime(Sys.time(), start, units = "secs") > timeout) { + break + } } return(invisible(self)) } @@ -233,8 +250,7 @@ wrs_log_script <- function(script, self, private, super) { # Set the execute directory of the Quarto process calling the script quarto_execute_dir <- options::opt("execute_dir", env = "whirl") if (is.null(quarto_execute_dir)) { - quarto_execute_dir <- switch( - get_file_ext(script), + quarto_execute_dir <- switch(get_file_ext(script), "R" = getwd(), normalizePath(dirname(script)) ) @@ -252,7 +268,7 @@ wrs_log_script <- function(script, self, private, super) { private$pb <- pb_script$new( script = private$current_script, use_progress = private$verbosity_level == "verbose" - ) + ) } self$pb_update(status = "Running script") @@ -293,7 +309,7 @@ wrs_create_log <- function(self, private, super) { con <- file( description = self$run(Sys.getenv, list("WHIRL_LOG_MSG")), open = "a" - ) + ) jsonlite::stream_out(x = strace_msg, con = con, verbose = FALSE) close(con) } @@ -338,15 +354,17 @@ wrs_create_outputs <- function(out_dir, format, self, private, super) { session_info_rlist = file.path(self$get_wd(), "objects.rds") |> readRDS() |> unlist(recursive = FALSE), - log_details = list(location = file.path( - out_dir, - gsub( - pattern = "\\.[^\\.]*$", - replacement = "_log.html", - x = basename(private$current_script) - ) - ), - script = private$current_script) + log_details = list( + location = file.path( + out_dir, + gsub( + pattern = "\\.[^\\.]*$", + replacement = "_log.html", + x = basename(private$current_script) + ) + ), + script = private$current_script + ) ) # Create requested outputs diff --git a/README.Rmd b/README.Rmd index e54ffb8..df9fa79 100644 --- a/README.Rmd +++ b/README.Rmd @@ -18,8 +18,8 @@ options(whirl.verbosity_level = "minimal") # Use a temporary directory as working directory with all examples available tmp <- withr::local_tempdir() -system.file("examples", package = "whirl") |> - list.files(full.names = TRUE) |> +system.file("examples", package = "whirl") |> + list.files(full.names = TRUE) |> file.copy(to = tmp) knitr::opts_knit$set(root.dir = tmp) diff --git a/README.md b/README.md index da70a59..4748083 100644 --- a/README.md +++ b/README.md @@ -69,11 +69,11 @@ the script execution similar to the content of the summary above: ``` r print(result) -#> # A tibble: 2 × 5 -#> id tag script status result -#> -#> 1 1 /private/var/folders/fx/71by3f551qzb5wkxt82cv… succe… -#> 2 2 /private/var/folders/fx/71by3f551qzb5wkxt82cv… warni… +#> # A tibble: 2 × 6 +#> id tag script status result log_dir +#> +#> 1 1 /private/var/folders/fx/71by3f551qzb5… succe… /priva… +#> 2 2 /private/var/folders/fx/71by3f551qzb5… warni… /priva… ``` ## Config files @@ -111,12 +111,12 @@ result <- run("_whirl.yaml", n_workers = 2) ``` r print(result) -#> # A tibble: 3 × 5 -#> id tag script status result -#> -#> 1 1 /private/var/folders/fx/71by3f551qzb5wkxt82cv… succe… -#> 2 2 /private/var/folders/fx/71by3f551qzb5wkxt82cv… warni… -#> 3 3 /private/var/folders/fx/71by3f551qzb5wkxt82cv… error +#> # A tibble: 3 × 6 +#> id tag script status result log_dir +#> +#> 1 1 /private/var/folders/fx/71by3f551qzb5… succe… /priva… +#> 2 2 /private/var/folders/fx/71by3f551qzb5… warni… /priva… +#> 3 3 /private/var/folders/fx/71by3f551qzb5… error /priva… ``` ## Customize run() diff --git a/inst/WORDLIST b/inst/WORDLIST new file mode 100644 index 0000000..8bb6690 --- /dev/null +++ b/inst/WORDLIST @@ -0,0 +1,81 @@ +Aksel +alway +aut +callr +Cervan +cgid +cli +commonmark +config +Config +cph +cre +Defeault +dev +dir +dplyr +exampel +excuted +Falgreen +Gakava +getenv +getOption +gfm +ggplot +Girard +github +globbing +GxP +https +httr +io +jsonlite +kableExtra +knitr +Kristian +ktqn +Lovemore +lvgk +markua +md +Nordisk +Novo +novonordisk +NovoNordisk +Obucina +opensource +OpenSource +overwritable +PKGS +pkgs +Possiblities +pre +purrr +README +renv +RENV +reticulate +rlang +rmarkdown +Roxygen +roxygen +RoxygenNote +sessioninfo +setenv +sffl +simultanous +simultanously +Steffen +stringr +Sys +testthat +Thomsen +tibble +tidyr +Troejelsgaard +unglue +usethis +VignetteBuilder +vlob +withr +yaml diff --git a/inst/documents/dummy.qmd b/inst/documents/dummy.qmd index 258d59b..82c9c8c 100644 --- a/inst/documents/dummy.qmd +++ b/inst/documents/dummy.qmd @@ -63,20 +63,23 @@ knitr::spin_child(params$script) python_packages <- NULL -if (file.exists(file.path(params$tmpdir, "python_imports.json"))){ - python_packages <- whirl:::python_package_info(file.path(params$tmpdir, "python_imports.json")) +if (file.exists(file.path(params$tmpdir, "python_imports.json"))) { + python_packages <- whirl:::python_package_info( + json = file.path(params$tmpdir, "python_imports.json") + ) } saveRDS( object = whirl:::session_info( - approved_folder_pkgs = params$check_approved_folder_pkgs, - approved_url_pkgs = params$check_approved_url_pkgs, + approved_folder_pkgs = params$check_approved_folder_pkgs, + approved_url_pkgs = params$check_approved_url_pkgs, python_packages = python_packages - ), + ), file = file.path(params$tmpdir, "session_info.rds") ) -if (is.character(params$renv) && params$renv == "yes" | is.logical(params$renv) && params$renv) { +if (is.character(params$renv) && params$renv == "yes" || + is.logical(params$renv) && params$renv) { saveRDS( object = whirl:::renv_status(), file = file.path(params$tmpdir, "renv_status.rds") diff --git a/inst/documents/log.qmd b/inst/documents/log.qmd index 472dcbc..0b2c1a3 100644 --- a/inst/documents/log.qmd +++ b/inst/documents/log.qmd @@ -34,7 +34,7 @@ format: #| echo: false status <- params$tmpdir |> - file.path("doc.md") |> + file.path("doc.md") |> whirl:::get_status() status_txt <- status[c("error", "warning")] @@ -59,8 +59,8 @@ whirl:::quarto_callout( #| echo: false #| eval: !expr file.exists(file.path(params$tmpdir, "renv_status.rds")) -params$tmpdir |> - file.path("renv_status.rds") |> +params$tmpdir |> + file.path("renv_status.rds") |> readRDS() ``` @@ -71,9 +71,9 @@ log_info <- whirl:::read_from_log() use_log_info <- nrow(log_info) > 0 if (use_log_info) { - log_info <- log_info |> - dplyr::arrange(time) |> - whirl:::split_log() + log_info <- log_info |> + dplyr::arrange(time) |> + whirl:::split_log() } ``` @@ -135,9 +135,9 @@ knitr::opts_chunk$set( echo = FALSE ) -info <- params$tmpdir |> - file.path("session_info.rds") |> - readRDS() +info <- params$tmpdir |> + file.path("session_info.rds") |> + readRDS() ``` ```{r} @@ -164,7 +164,7 @@ info$python_packages #| fig.height: 0.5 cat("\n## R Packages\n") -if (!is.null(params$check_approved_folder_pkgs) | +if (!is.null(params$check_approved_folder_pkgs) || !is.null(params$check_approved_url_pkgs)) { whirl:::create_approval_plot(info$packages |> data.frame()) } diff --git a/man/custom_logging.Rd b/man/custom_logging.Rd index 99d2134..4646262 100644 --- a/man/custom_logging.Rd +++ b/man/custom_logging.Rd @@ -14,7 +14,8 @@ log_write(file, log = Sys.getenv("WHIRL_LOG_MSG")) log_delete(file, log = Sys.getenv("WHIRL_LOG_MSG")) } \arguments{ -\item{file}{\code{\link[=character]{character()}} description of the file that was read, written or deleted.} +\item{file}{\code{\link[=character]{character()}} description of the file that was read, written or +deleted.} \item{log}{\code{\link[=character]{character()}} path to the log file.} } @@ -23,9 +24,9 @@ Useful for e.g. read and write operations on databases etc. that are not automatically captured. } \details{ -The default environment variable \code{WHIRL_LOG_MSG} is set in the session used to log scripts, and input -is automatically captured in the resulting log. +The default environment variable \code{WHIRL_LOG_MSG} is set in the session used +to log scripts, and input is automatically captured in the resulting log. -If run outside of whirl, meaning when the above environment variable is unset, the operations -are streamed to \code{stdout()}. By default the console. +If run outside of whirl, meaning when the above environment variable is +unset, the operations are streamed to \code{stdout()}. By default the console. } diff --git a/man/options.Rd b/man/options.Rd index 38ee6c4..6741e55 100644 --- a/man/options.Rd +++ b/man/options.Rd @@ -21,13 +21,15 @@ options::opt(x, default, env = "whirl") \describe{ \item{out_formats}{\describe{ -Which log format(s) to produce. Possiblities are \code{html}, \code{json}, and markdown formats:\code{gfm}, \code{commonmark}, and \code{markua}.\item{default: }{\preformatted{"html"}} +Which log format(s) to produce. Possiblities are \code{html}, \code{json}, and +markdown formats: \code{gfm}, \code{commonmark}, and \code{markua}.\item{default: }{\preformatted{"html"}} \item{option: }{whirl.out_formats} \item{envvar: }{R_WHIRL_OUT_FORMATS (evaluated if possible, raw string otherwise)} }} \item{track_files}{\describe{ -Should files read and written be tracked? Currently only supported on Linux.\item{default: }{\preformatted{FALSE}} +Should files read and written be tracked? +Currently only supported on Linux.\item{default: }{\preformatted{FALSE}} \item{option: }{whirl.track_files} \item{envvar: }{R_WHIRL_TRACK_FILES (TRUE if one of 'TRUE', '1', FALSE otherwise)} }} @@ -46,13 +48,15 @@ List of file naming patterns not be tracked when track_files = TRUE\item{default }} \item{track_files_keep}{\describe{ -List of file naming patterns alway to be tracked when track_files = TRUE\item{default: }{\preformatted{paste0("^", getwd())}} +List of file naming patterns alway to be tracked when +track_files = TRUE\item{default: }{\preformatted{paste0("^", getwd())}} \item{option: }{whirl.track_files_keep} \item{envvar: }{R_WHIRL_TRACK_FILES_KEEP (as character vector, split on ';' delimiter)} }} \item{verbosity_level}{\describe{ -How chatty should the log be? Possibilities are \code{quiet}, \code{minimal} and \code{verbose}.\item{default: }{\preformatted{"verbose"}} +How chatty should the log be? Possibilities are +\code{quiet}, \code{minimal} and \code{verbose}.\item{default: }{\preformatted{"verbose"}} \item{option: }{whirl.verbosity_level} \item{envvar: }{R_WHIRL_VERBOSITY_LEVEL (evaluated if possible, raw string otherwise)} }} @@ -70,19 +74,27 @@ Approved URL library packages\item{default: }{\preformatted{NULL}} }} \item{n_workers}{\describe{ -Number of simultanous workers used in the run function. A maximum of 128 workers is allowed.\item{default: }{\preformatted{1}} +Number of simultanous workers used in the run function. +A maximum of 128 workers is allowed.\item{default: }{\preformatted{1}} \item{option: }{whirl.n_workers} \item{envvar: }{R_WHIRL_N_WORKERS (evaluated if possible, raw string otherwise)} }} \item{log_dir}{\describe{ -The output directory of the log files. Default is the folder of the excuted script. log_dir can be a path as a character or it can be a function that takes the script path as input and returns the log directory. For more information see the examples of \code{run()} or \code{vignette('whirl')}.\item{default: }{\preformatted{dirname}} +The output directory of the log files. Default is the folder of the +excuted script. log_dir can be a path as a character or it can be a function +that takes the script path as input and returns the log directory. +For more information see the examples of \code{run()} or \code{vignette('whirl')}.\item{default: }{\preformatted{dirname}} \item{option: }{whirl.log_dir} \item{envvar: }{R_WHIRL_LOG_DIR (evaluated if possible, raw string otherwise)} }} \item{execute_dir}{\describe{ -The working directory of the process executing each script. Defeault us to execute R files from the working directory when calling \code{run()} and all other functions from the directory of the script. To change provide a character path (used for all scripts) or a function that takes the script as input and returns the execution directory.\item{default: }{\preformatted{NULL}} +The working directory of the process executing each script. +Defeault us to execute R files from the working directory when calling \code{run()} +and all other functions from the directory of the script. To change provide +a character path (used for all scripts) or a function that takes the script +as input and returns the execution directory.\item{default: }{\preformatted{NULL}} \item{option: }{whirl.execute_dir} \item{envvar: }{R_WHIRL_EXECUTE_DIR (evaluated if possible, raw string otherwise)} }} diff --git a/man/options_params.Rd b/man/options_params.Rd index 0f75215..d9f35fe 100644 --- a/man/options_params.Rd +++ b/man/options_params.Rd @@ -4,25 +4,37 @@ \alias{options_params} \title{Internal reuse of options description} \arguments{ -\item{verbosity_level}{How chatty should the log be? Possibilities are \code{quiet}, \code{minimal} and \code{verbose}. (Defaults to \code{"verbose"}, overwritable using option 'whirl.verbosity_level' or environment variable 'R_WHIRL_VERBOSITY_LEVEL')} +\item{verbosity_level}{How chatty should the log be? Possibilities are +\code{quiet}, \code{minimal} and \code{verbose}. (Defaults to \code{"verbose"}, overwritable using option 'whirl.verbosity_level' or environment variable 'R_WHIRL_VERBOSITY_LEVEL')} -\item{log_dir}{The output directory of the log files. Default is the folder of the excuted script. log_dir can be a path as a character or it can be a function that takes the script path as input and returns the log directory. For more information see the examples of \code{run()} or \code{vignette('whirl')}. (Defaults to \code{dirname}, overwritable using option 'whirl.log_dir' or environment variable 'R_WHIRL_LOG_DIR')} +\item{log_dir}{The output directory of the log files. Default is the folder of the +excuted script. log_dir can be a path as a character or it can be a function +that takes the script path as input and returns the log directory. +For more information see the examples of \code{run()} or \code{vignette('whirl')}. (Defaults to \code{dirname}, overwritable using option 'whirl.log_dir' or environment variable 'R_WHIRL_LOG_DIR')} -\item{n_workers}{Number of simultanous workers used in the run function. A maximum of 128 workers is allowed. (Defaults to \code{1}, overwritable using option 'whirl.n_workers' or environment variable 'R_WHIRL_N_WORKERS')} +\item{n_workers}{Number of simultanous workers used in the run function. +A maximum of 128 workers is allowed. (Defaults to \code{1}, overwritable using option 'whirl.n_workers' or environment variable 'R_WHIRL_N_WORKERS')} -\item{execute_dir}{The working directory of the process executing each script. Defeault us to execute R files from the working directory when calling \code{run()} and all other functions from the directory of the script. To change provide a character path (used for all scripts) or a function that takes the script as input and returns the execution directory. (Defaults to \code{NULL}, overwritable using option 'whirl.execute_dir' or environment variable 'R_WHIRL_EXECUTE_DIR')} +\item{execute_dir}{The working directory of the process executing each script. +Defeault us to execute R files from the working directory when calling \code{run()} +and all other functions from the directory of the script. To change provide +a character path (used for all scripts) or a function that takes the script +as input and returns the execution directory. (Defaults to \code{NULL}, overwritable using option 'whirl.execute_dir' or environment variable 'R_WHIRL_EXECUTE_DIR')} \item{track_files_discards}{List of file naming patterns not be tracked when track_files = TRUE (Defaults to \verb{c("^/lib", "^/etc", "^/lib64", "^/usr", "^/var", "^/opt", "^/sys", ; "^/proc", "^/tmp", "^/null", "^/urandom", "^/.cache", .libPaths())}, overwritable using option 'whirl.track_files_discards' or environment variable 'R_WHIRL_TRACK_FILES_DISCARDS')} -\item{track_files}{Should files read and written be tracked? Currently only supported on Linux. (Defaults to \code{FALSE}, overwritable using option 'whirl.track_files' or environment variable 'R_WHIRL_TRACK_FILES')} +\item{track_files}{Should files read and written be tracked? +Currently only supported on Linux. (Defaults to \code{FALSE}, overwritable using option 'whirl.track_files' or environment variable 'R_WHIRL_TRACK_FILES')} -\item{out_formats}{Which log format(s) to produce. Possiblities are \code{html}, \code{json}, and markdown formats:\code{gfm}, \code{commonmark}, and \code{markua}. (Defaults to \code{"html"}, overwritable using option 'whirl.out_formats' or environment variable 'R_WHIRL_OUT_FORMATS')} +\item{out_formats}{Which log format(s) to produce. Possiblities are \code{html}, \code{json}, and +markdown formats: \code{gfm}, \code{commonmark}, and \code{markua}. (Defaults to \code{"html"}, overwritable using option 'whirl.out_formats' or environment variable 'R_WHIRL_OUT_FORMATS')} \item{approved_pkgs_folder}{Approved folder library packages (Defaults to \code{NULL}, overwritable using option 'whirl.approved_pkgs_folder' or environment variable 'R_WHIRL_APPROVED_PKGS_FOLDER')} \item{check_renv}{Should the projects renv status be checked? (Defaults to \code{FALSE}, overwritable using option 'whirl.check_renv' or environment variable 'R_WHIRL_CHECK_RENV')} -\item{track_files_keep}{List of file naming patterns alway to be tracked when track_files = TRUE (Defaults to \code{paste0("^", getwd())}, overwritable using option 'whirl.track_files_keep' or environment variable 'R_WHIRL_TRACK_FILES_KEEP')} +\item{track_files_keep}{List of file naming patterns alway to be tracked when +track_files = TRUE (Defaults to \code{paste0("^", getwd())}, overwritable using option 'whirl.track_files_keep' or environment variable 'R_WHIRL_TRACK_FILES_KEEP')} \item{approved_pkgs_url}{Approved URL library packages (Defaults to \code{NULL}, overwritable using option 'whirl.approved_pkgs_url' or environment variable 'R_WHIRL_APPROVED_PKGS_URL')} } diff --git a/man/run.Rd b/man/run.Rd index b57c86e..f785d60 100644 --- a/man/run.Rd +++ b/man/run.Rd @@ -31,17 +31,24 @@ then all steps listed in the config file will be executed.} \item{summary_file}{A character string specifying the file path where the summary log will be stored.} -\item{n_workers}{Number of simultanous workers used in the run function. A maximum of 128 workers is allowed. (Defaults to \code{1}, overwritable using option 'whirl.n_workers' or environment variable 'R_WHIRL_N_WORKERS')} +\item{n_workers}{Number of simultanous workers used in the run function. +A maximum of 128 workers is allowed. (Defaults to \code{1}, overwritable using option 'whirl.n_workers' or environment variable 'R_WHIRL_N_WORKERS')} \item{check_renv}{Should the projects renv status be checked? (Defaults to \code{FALSE}, overwritable using option 'whirl.check_renv' or environment variable 'R_WHIRL_CHECK_RENV')} -\item{verbosity_level}{How chatty should the log be? Possibilities are \code{quiet}, \code{minimal} and \code{verbose}. (Defaults to \code{"verbose"}, overwritable using option 'whirl.verbosity_level' or environment variable 'R_WHIRL_VERBOSITY_LEVEL')} +\item{verbosity_level}{How chatty should the log be? Possibilities are +\code{quiet}, \code{minimal} and \code{verbose}. (Defaults to \code{"verbose"}, overwritable using option 'whirl.verbosity_level' or environment variable 'R_WHIRL_VERBOSITY_LEVEL')} -\item{track_files}{Should files read and written be tracked? Currently only supported on Linux. (Defaults to \code{FALSE}, overwritable using option 'whirl.track_files' or environment variable 'R_WHIRL_TRACK_FILES')} +\item{track_files}{Should files read and written be tracked? +Currently only supported on Linux. (Defaults to \code{FALSE}, overwritable using option 'whirl.track_files' or environment variable 'R_WHIRL_TRACK_FILES')} -\item{out_formats}{Which log format(s) to produce. Possiblities are \code{html}, \code{json}, and markdown formats:\code{gfm}, \code{commonmark}, and \code{markua}. (Defaults to \code{"html"}, overwritable using option 'whirl.out_formats' or environment variable 'R_WHIRL_OUT_FORMATS')} +\item{out_formats}{Which log format(s) to produce. Possiblities are \code{html}, \code{json}, and +markdown formats: \code{gfm}, \code{commonmark}, and \code{markua}. (Defaults to \code{"html"}, overwritable using option 'whirl.out_formats' or environment variable 'R_WHIRL_OUT_FORMATS')} -\item{log_dir}{The output directory of the log files. Default is the folder of the excuted script. log_dir can be a path as a character or it can be a function that takes the script path as input and returns the log directory. For more information see the examples of \code{run()} or \code{vignette('whirl')}. (Defaults to \code{dirname}, overwritable using option 'whirl.log_dir' or environment variable 'R_WHIRL_LOG_DIR')} +\item{log_dir}{The output directory of the log files. Default is the folder of the +excuted script. log_dir can be a path as a character or it can be a function +that takes the script path as input and returns the log directory. +For more information see the examples of \code{run()} or \code{vignette('whirl')}. (Defaults to \code{dirname}, overwritable using option 'whirl.log_dir' or environment variable 'R_WHIRL_LOG_DIR')} } \value{ A tibble containing the execution results for all the scripts. @@ -56,9 +63,11 @@ e.g. the verbosity of the logs. See \link{options} on how to configure these. \examples{ # Start by copying the following three example scripts: file.copy( - from = system.file("examples", c("success.R", "warning.R", "error.R"), package = "whirl"), + from = system.file("examples", c("success.R", "warning.R", "error.R"), + package = "whirl" + ), to = "." - ) +) # Run a single script run("success.R") @@ -71,20 +80,23 @@ run( list( c("success.R", "warning.R"), "error.R" - ), - n_workers = 2) + ), + n_workers = 2 +) \dontshow{if (FALSE) (if (getRversion() >= "3.4") withAutoprint else force)(\{ # examplesIf} # Re-directing the logs to a sub-folder by utilizing the log_dir argument in -# run(). This will require that the sub-folder exist and the code is therefore -# not executed +# run(). This will require that the sub-folder exist and the code is +# therefore not executed # Specifying the path using a manually defined character run("success.R", log_dir = getwd()) # Specifying the path with a generic function that can handle the scripts # individually. -run("success.R", log_dir = function(x) {paste0(dirname(x), "/logs")}) +run("success.R", log_dir = function(x) { + paste0(dirname(x), "/logs") +}) \dontshow{\}) # examplesIf} } diff --git a/man/use_whirl.Rd b/man/use_whirl.Rd index 3285719..0631119 100644 --- a/man/use_whirl.Rd +++ b/man/use_whirl.Rd @@ -16,5 +16,6 @@ Utility function to setup execution with whirl in your project: \item Updates \code{.gitignore} to not include log files } -See \code{vignette("whirl")} for how to specify paths inside the configuration file. +See \code{vignette("whirl")} for how to specify paths inside the +configuration file. } diff --git a/tests/testthat/helper.R b/tests/testthat/helper.R index 847238a..f5888b2 100644 --- a/tests/testthat/helper.R +++ b/tests/testthat/helper.R @@ -1,7 +1,7 @@ # Helper function to select test scripts test_script <- function(script) { - script <- test_path("scripts", script) |> + script <- testthat::test_path("scripts", script) |> normalizePath(winslash = "/", mustWork = TRUE) return(script) } diff --git a/tests/testthat/scripts/error.R b/tests/testthat/scripts/error.R index d03e9a4..eab9a40 100644 --- a/tests/testthat/scripts/error.R +++ b/tests/testthat/scripts/error.R @@ -1,4 +1,3 @@ - # This script produces error for testing purposes stop("This is an error!") diff --git a/tests/testthat/scripts/success.R b/tests/testthat/scripts/success.R index 87cf481..e2394b1 100644 --- a/tests/testthat/scripts/success.R +++ b/tests/testthat/scripts/success.R @@ -1,4 +1,3 @@ - # This script produces no errors or warnings for testing purposes message("this script has no errors or warnings") diff --git a/tests/testthat/scripts/warning.R b/tests/testthat/scripts/warning.R index c39473b..dac2428 100644 --- a/tests/testthat/scripts/warning.R +++ b/tests/testthat/scripts/warning.R @@ -1,4 +1,3 @@ - # This script produces a warning for testing purposes warning("this is a warning") diff --git a/tests/testthat/test-custom_logging.R b/tests/testthat/test-custom_logging.R index 3937e71..d59afa6 100644 --- a/tests/testthat/test-custom_logging.R +++ b/tests/testthat/test-custom_logging.R @@ -1,24 +1,22 @@ test_that("stream to console outside whirl context", { - log_read("test_read") |> expect_output( regexp = "\\{\"time\":\".*\",\"type\":\"read\",\"file\":\"test_read\"\\}" - ) + ) log_write("test_write") |> expect_output( regexp = "\\{\"time\":\".*\",\"type\":\"write\",\"file\":\"test_write\"\\}" - ) + ) log_delete("test_delete") |> expect_output( regexp = "\\{\"time\":\".*\",\"type\":\"delete\",\"file\":\"test_delete\"\\}" - ) + ) }) test_that("stream to log file in a whirl context", { - tmp_log_file <- withr::local_tempfile(fileext = ".json") withr::with_envvar( @@ -35,5 +33,4 @@ test_that("stream to log file in a whirl context", { expect_equal(x$file, c("test_read", "test_write", "test_delete")) } ) - }) diff --git a/tests/testthat/test-enrich_input.R b/tests/testthat/test-enrich_input.R index fe307e9..b9b6aa7 100644 --- a/tests/testthat/test-enrich_input.R +++ b/tests/testthat/test-enrich_input.R @@ -1,5 +1,4 @@ test_that("Enrich input works as expected", { - # Find all R programs enriched <- test_script("_whirl_r_programs.yaml") |> @@ -21,7 +20,9 @@ test_that("Enrich input works as expected", { expect_type("list") |> expect_length(3) |> vapply(FUN = \(x) x$name, FUN.VALUE = character(1)) |> - expect_equal(c("Named step", "Step 2: Unnamed chunk", "Step 3: Unnamed chunk")) + expect_equal( + c("Named step", "Step 2: Unnamed chunk", "Step 3: Unnamed chunk") + ) # File input @@ -39,8 +40,8 @@ test_that("Enrich input works as expected", { c( name = "Step 1: Unnamed chunk", paths = test_script("success.R") - ) ) + ) # Pruning a config file @@ -72,4 +73,4 @@ test_that("Enrich input works as expected", { expect_length(1) |> vapply(FUN = \(x) x$name, FUN.VALUE = character(1)) |> expect_match(regexp = format(Sys.Date())) - }) +}) diff --git a/tests/testthat/test-examples.R b/tests/testthat/test-examples.R index 133024a..73e2812 100644 --- a/tests/testthat/test-examples.R +++ b/tests/testthat/test-examples.R @@ -1,7 +1,5 @@ test_that("All example scripts run with consistent output", { - withr::with_tempdir({ - # Copy all example scripts to the temporary working directory system.file("examples", package = "whirl") |> diff --git a/tests/testthat/test-internal_run.R b/tests/testthat/test-internal_run.R index e413346..2097c1d 100644 --- a/tests/testthat/test-internal_run.R +++ b/tests/testthat/test-internal_run.R @@ -1,5 +1,4 @@ test_that("testing internal_run()", { - # A config file q <- whirl_queue$new(n_workers = 2) @@ -15,5 +14,4 @@ test_that("testing internal_run()", { test_script("_whirl_to_config.yaml") |> internal_run(steps = NULL, level = 1, queue = q) |> expect_no_error() - }) diff --git a/tests/testthat/test-read_glob.R b/tests/testthat/test-read_glob.R index 9eea810..656d413 100644 --- a/tests/testthat/test-read_glob.R +++ b/tests/testthat/test-read_glob.R @@ -1,5 +1,4 @@ test_that("testing read_glob()", { - # A single file test_script("success.R") |> read_glob() |> @@ -18,5 +17,4 @@ test_that("testing read_glob()", { file.path("fake_program.R") |> read_glob() |> expect_message() - }) diff --git a/tests/testthat/test-run.R b/tests/testthat/test-run.R index 0090d41..b528955 100644 --- a/tests/testthat/test-run.R +++ b/tests/testthat/test-run.R @@ -1,5 +1,4 @@ test_that("Run single R script", { - res <- test_script("success.R") |> run() |> expect_no_condition() @@ -10,11 +9,9 @@ test_that("Run single R script", { res[["result"]][[1]] |> names() |> expect_equal(c("status", "session_info_rlist", "log_details")) - }) test_that("Run single python script", { - res <- test_script("py_success.py") |> run() |> expect_no_condition() @@ -25,11 +22,9 @@ test_that("Run single python script", { res[["result"]][[1]] |> names() |> expect_equal(c("status", "session_info_rlist", "log_details")) - }) test_that("Run multiple R scripts", { - res <- test_script(c("success.R", "warning.R", "error.R")) |> run(n_workers = 2) |> expect_no_error() @@ -54,7 +49,6 @@ test_that("Run multiple R scripts", { }) test_that("Run multiple python scripts", { - res <- test_script(c("py_success.py", "py_warning.py", "py_error.py")) |> run(n_workers = 2) |> expect_no_error() @@ -79,48 +73,47 @@ test_that("Run multiple python scripts", { }) test_that("Run yaml config file", { - res <- test_script("_whirl.yaml") |> run(n_workers = 2) |> expect_no_error() - }) test_that("Change the log_dir to a path", { - #Custom path + # Custom path custom_path <- withr::local_tempdir() - #Execute run() with log_dir = custom path + # Execute run() with log_dir = custom path res <- test_script("success.R") |> run(log_dir = custom_path) |> expect_no_error() - #Check if the log file is created in the custom path + # Check if the log file is created in the custom path file.path(custom_path, "success_log.html") |> file.exists() |> expect_true() }) test_that("Change the log_dir with a function", { - #Custom path and copy script + # Custom path and copy script custom_path <- withr::local_tempdir() dir.create(file.path(custom_path, "logs")) file.copy(from = test_script("warning.R"), to = custom_path) |> expect_true() - #Execute run() with log_dir as a function + # Execute run() with log_dir as a function res <- file.path(custom_path, "warning.R") |> - run(log_dir = function(x) {paste0(dirname(x), "/logs")}) |> + run(log_dir = function(x) { + paste0(dirname(x), "/logs") + }) |> expect_no_error() - #Check if the log file is created in the correct folder + # Check if the log file is created in the correct folder file.path(custom_path, "logs", "warning_log.html") |> file.exists() |> expect_true() }) test_that("Change the execute_dir to a path", { - custom_path <- withr::local_tempdir() withr::local_options(whirl.execute_dir = custom_path) @@ -136,11 +129,9 @@ test_that("Change the execute_dir to a path", { }) test_that("Change the execute_dir to a function", { - withr::local_options(whirl.execute_dir = \(x) dirname(x)) test_script("success.R") |> run() |> expect_no_error() }) - diff --git a/tests/testthat/test-strace.R b/tests/testthat/test-strace.R index abc33bf..02ef7db 100644 --- a/tests/testthat/test-strace.R +++ b/tests/testthat/test-strace.R @@ -10,12 +10,6 @@ test_that("strace works", { start_strace(pid = p$get_pid(), file = file.path(getwd(), "strace.log")) - # cat("============= Initial: =============", "\n") - # cat(c("wd:", getwd()), "\n") - # cat(c("files:", list.files()), "\n") - # cat(c("environment:", ls()), "\n") - # cat("====================================", "\n") - # No output yet p$run(\() 1 + 1) @@ -98,12 +92,6 @@ test_that("strace works", { p$kill() p$finalize() - - # cat("============= final: =============", "\n") - # cat(c("wd:", getwd()), "\n") - # cat(c("files:", list.files()), "\n") - # cat(c("environment:", ls()), "\n") - # cat("==================================", "\n") }, tmpdir = getwd() ) diff --git a/tests/testthat/test-util_queue_summary.R b/tests/testthat/test-util_queue_summary.R index c9dd6d6..20abae4 100644 --- a/tests/testthat/test-util_queue_summary.R +++ b/tests/testthat/test-util_queue_summary.R @@ -1,25 +1,25 @@ # Test for existence of 'result' in the queue_table test_that("queue_table must contain a list named 'result'", { - list(dummy = "dummy") |> util_queue_summary() |> expect_error("queue_table must contain a list named 'result'") - }) # Test for existence of 'log_details' and 'status' in each result -test_that("Each result in queue_table must contain 'log_details' and 'status'", { - - list(result = list(list(log_details = "dummy"))) |> - util_queue_summary() |> - expect_error("Each result in queue_table must contain 'log_details' and 'status'") - -}) +test_that( + "Each result in queue_table must contain 'log_details' and 'status'", + { + list(result = list(list(log_details = "dummy"))) |> + util_queue_summary() |> + expect_error( + "Each result in queue_table must contain 'log_details' and 'status'" + ) + } +) # Test for successful creation of summary tibble test_that("Summary tibble is created successfully", { - q <- whirl_queue$new(n_workers = 2) test_script(c("success.R", "py_success.py")) |> @@ -28,7 +28,9 @@ test_that("Summary tibble is created successfully", { q$queue |> util_queue_summary() |> expect_s3_class("tbl_df") |> - expect_named(c('Directory', 'Filename', 'Status', 'Hyperlink', 'Information')) |> + expect_named( + c("Directory", "Filename", "Status", "Hyperlink", "Information") + ) |> nrow() |> expect_equal(2) }) diff --git a/vignettes/articles/example.Rmd b/vignettes/articles/example.Rmd index cca1575..ae301cb 100644 --- a/vignettes/articles/example.Rmd +++ b/vignettes/articles/example.Rmd @@ -8,12 +8,12 @@ knitr::opts_chunk$set( comment = "#>" ) -# Use a temporary directory as working directory with the example program available +# Use a temporary directory as working directory with the example program wd <- getwd() tmp <- withr::local_tempdir() -system.file("examples/prg1.R", package = "whirl") |> +system.file("examples/prg1.R", package = "whirl") |> file.copy(to = file.path(tmp, "example.R")) knitr::opts_knit$set(root.dir = tmp) @@ -51,14 +51,14 @@ The script is now executed and you can access the logs below: articles_folder <- file.path(wd, "../../docs/articles") -articles_folder |> - dir.exists() |> +articles_folder |> + dir.exists() |> stopifnot() -c("summary.html", "example_log.html", "plot1.png") |> - lapply(file.copy, to = articles_folder, overwrite = TRUE) |> - unlist() |> - all() |> +c("summary.html", "example_log.html", "plot1.png") |> + lapply(file.copy, to = articles_folder, overwrite = TRUE) |> + unlist() |> + all() |> stopifnot() ``` diff --git a/vignettes/whirl.Rmd b/vignettes/whirl.Rmd index f5b5b86..a7a4dae 100644 --- a/vignettes/whirl.Rmd +++ b/vignettes/whirl.Rmd @@ -39,15 +39,15 @@ The location of the summary file can be controlled with the `summary_file` argum ```{r} # Execution of all R files in a specific directory run( - input = "path/to/directory/*.R", - n_workers = 4, + input = "path/to/directory/*.R", + n_workers = 4, summary_file = "path/to/summary" ) # Execution of all R files starting with "mk200" in a specific directory run( - input = "path/to/directory/mk200*.R", - n_workers = 8, + input = "path/to/directory/mk200*.R", + n_workers = 8, summary_file = "path/to/summary" ) ``` @@ -63,28 +63,30 @@ If the scripts have to be executed in a specific order, the `input` argument can ```{r} # In the below example, script1.R and script2.R will be executed in parallel run( - input = c("path/to/script1.R", - "path/to/script2.R"), + input = c( + "path/to/script1.R", + "path/to/script2.R" + ), n_workers = 2 ) -# In the below example, script1.R and script2.R will be executed in parallel, +# In the below example, script1.R and script2.R will be executed in parallel, # and all R files in the directory will subsequently be executed in parallel run( input = list( - c("path/to/script1.R", "path/to/script2.R"), + c("path/to/script1.R", "path/to/script2.R"), "path/to/directory/*.R" - ), + ), n_workers = 2 ) -# In the below example, script1.R and script2.R will be executed in parallel, and subsequently -# script3.R and script4.R will be executed in parallel +# In the below example, script1.R and script2.R will be executed in parallel, +# and subsequently script3.R and script4.R will be executed in parallel run( input = list( c("path/to/script1.R", "path/to/script2.R"), c("path/to/script3.R", "path/to/script4.R") - ), + ), n_workers = 2 ) ``` @@ -94,14 +96,15 @@ This can be useful during execution as some of these 'name' will be printed to t E.g. ```{r} -run(input = list( - list( - name = "Step 1", - paths = c("path/to/script1.R", "path/to/script2.R") +run( + input = list( + list( + name = "Step 1", + paths = c("path/to/script1.R", "path/to/script2.R") ), - list( - name = "Step 2", - paths = c("path/to/script3.R", "path/to/script4.R") + list( + name = "Step 2", + paths = c("path/to/script3.R", "path/to/script4.R") ) ), n_workers = 2 @@ -155,8 +158,12 @@ If a more dynamic approach is needed the `log_dir` argument can also be supplied For example, if multiple script are executed and the logs needs to be stored in a sub-folder within the script directories this could be achieved by: ```{r} -run(input = c("path/to/dir1/script1.R", "path/to/dir2/script2.R"), - log_dir = function(x) {paste0(dirname(x), "/logs")}) +run( + input = c("path/to/dir1/script1.R", "path/to/dir2/script2.R"), + log_dir = function(x) { + paste0(dirname(x), "/logs") + } +) ``` In this exampel the log of script1.R will be stored in **path/to/dir1/logs** and the log of script2.R will be stored in **path/to/dir2/logs**. From 5188fefc4a282df1de9290e657b840752dad62be Mon Sep 17 00:00:00 2001 From: akselthomsen Date: Wed, 18 Dec 2024 15:02:20 +0100 Subject: [PATCH 04/14] fix: spelling errors --- .Rbuildignore | 1 + DESCRIPTION | 2 +- R/options.R | 10 +++++----- inst/WORDLIST | 7 ------- man/options.Rd | 10 +++++----- man/options_params.Rd | 10 +++++----- man/run.Rd | 6 +++--- man/whirl-package.Rd | 2 +- vignettes/whirl.Rmd | 2 +- 9 files changed, 22 insertions(+), 28 deletions(-) diff --git a/.Rbuildignore b/.Rbuildignore index 94754f1..af59964 100644 --- a/.Rbuildignore +++ b/.Rbuildignore @@ -16,5 +16,6 @@ ^whirl.*\.tgz$ ^whirl\.Rcheck$ ^whirl\.Rproj$ +^înst/WORDLIST$ plot1.png summary.html diff --git a/DESCRIPTION b/DESCRIPTION index cdafabe..864ad01 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -10,7 +10,7 @@ Authors@R: c( person("Vladimir", "Obucina", , email = "vlob@novonordisk.com", role = "aut"), person("Novo Nordisk A/S", role = "cph") ) -Description: Provides functionalities for running R scripts in batch, while simultanously creating logs for each script execution. +Description: Provides functionalities for running R scripts in batch, while simultaneously creating logs for each script execution. License: Apache License (>= 2) URL: https://novonordisk-opensource.github.io/whirl/, https://github.com/novonordisk-opensource/whirl Depends: diff --git a/R/options.R b/R/options.R index bde1593..91cda9a 100644 --- a/R/options.R +++ b/R/options.R @@ -11,7 +11,7 @@ NULL options::define_option( option = "out_formats", default = "html", - desc = "Which log format(s) to produce. Possiblities are `html`, `json`, and + desc = "Which log format(s) to produce. Possibilities are `html`, `json`, and markdown formats: `gfm`, `commonmark`, and `markua`." ) @@ -54,7 +54,7 @@ options::define_option( options::define_option( option = "track_files_keep", default = paste0("^", getwd()), - desc = "List of file naming patterns alway to be tracked when + desc = "List of file naming patterns always to be tracked when track_files = TRUE", envvar_fn = options::envvar_str_split(delim = ";") ) @@ -83,7 +83,7 @@ options::define_option( options::define_option( option = "n_workers", default = 1, - desc = "Number of simultanous workers used in the run function. + desc = "Number of simultaneous workers used in the run function. A maximum of 128 workers is allowed." ) @@ -91,7 +91,7 @@ options::define_option( option = "log_dir", default = dirname, desc = "The output directory of the log files. Default is the folder of the - excuted script. log_dir can be a path as a character or it can be a function + executed script. log_dir can be a path as a character or it can be a function that takes the script path as input and returns the log directory. For more information see the examples of `run()` or `vignette('whirl')`." ) @@ -100,7 +100,7 @@ options::define_option( option = "execute_dir", default = NULL, desc = "The working directory of the process executing each script. - Defeault us to execute R files from the working directory when calling `run()` + Default us to execute R files from the working directory when calling `run()` and all other functions from the directory of the script. To change provide a character path (used for all scripts) or a function that takes the script as input and returns the execution directory." diff --git a/inst/WORDLIST b/inst/WORDLIST index 8bb6690..141a446 100644 --- a/inst/WORDLIST +++ b/inst/WORDLIST @@ -1,5 +1,4 @@ Aksel -alway aut callr Cervan @@ -10,12 +9,9 @@ config Config cph cre -Defeault dev dir dplyr -exampel -excuted Falgreen Gakava getenv @@ -48,7 +44,6 @@ OpenSource overwritable PKGS pkgs -Possiblities pre purrr README @@ -63,8 +58,6 @@ RoxygenNote sessioninfo setenv sffl -simultanous -simultanously Steffen stringr Sys diff --git a/man/options.Rd b/man/options.Rd index 6741e55..56d31b2 100644 --- a/man/options.Rd +++ b/man/options.Rd @@ -21,7 +21,7 @@ options::opt(x, default, env = "whirl") \describe{ \item{out_formats}{\describe{ -Which log format(s) to produce. Possiblities are \code{html}, \code{json}, and +Which log format(s) to produce. Possibilities are \code{html}, \code{json}, and markdown formats: \code{gfm}, \code{commonmark}, and \code{markua}.\item{default: }{\preformatted{"html"}} \item{option: }{whirl.out_formats} \item{envvar: }{R_WHIRL_OUT_FORMATS (evaluated if possible, raw string otherwise)} @@ -48,7 +48,7 @@ List of file naming patterns not be tracked when track_files = TRUE\item{default }} \item{track_files_keep}{\describe{ -List of file naming patterns alway to be tracked when +List of file naming patterns always to be tracked when track_files = TRUE\item{default: }{\preformatted{paste0("^", getwd())}} \item{option: }{whirl.track_files_keep} \item{envvar: }{R_WHIRL_TRACK_FILES_KEEP (as character vector, split on ';' delimiter)} @@ -74,7 +74,7 @@ Approved URL library packages\item{default: }{\preformatted{NULL}} }} \item{n_workers}{\describe{ -Number of simultanous workers used in the run function. +Number of simultaneous workers used in the run function. A maximum of 128 workers is allowed.\item{default: }{\preformatted{1}} \item{option: }{whirl.n_workers} \item{envvar: }{R_WHIRL_N_WORKERS (evaluated if possible, raw string otherwise)} @@ -82,7 +82,7 @@ A maximum of 128 workers is allowed.\item{default: }{\preformatted{1}} \item{log_dir}{\describe{ The output directory of the log files. Default is the folder of the -excuted script. log_dir can be a path as a character or it can be a function +executed script. log_dir can be a path as a character or it can be a function that takes the script path as input and returns the log directory. For more information see the examples of \code{run()} or \code{vignette('whirl')}.\item{default: }{\preformatted{dirname}} \item{option: }{whirl.log_dir} @@ -91,7 +91,7 @@ For more information see the examples of \code{run()} or \code{vignette('whirl') \item{execute_dir}{\describe{ The working directory of the process executing each script. -Defeault us to execute R files from the working directory when calling \code{run()} +Default us to execute R files from the working directory when calling \code{run()} and all other functions from the directory of the script. To change provide a character path (used for all scripts) or a function that takes the script as input and returns the execution directory.\item{default: }{\preformatted{NULL}} diff --git a/man/options_params.Rd b/man/options_params.Rd index d9f35fe..99a89ba 100644 --- a/man/options_params.Rd +++ b/man/options_params.Rd @@ -8,15 +8,15 @@ \code{quiet}, \code{minimal} and \code{verbose}. (Defaults to \code{"verbose"}, overwritable using option 'whirl.verbosity_level' or environment variable 'R_WHIRL_VERBOSITY_LEVEL')} \item{log_dir}{The output directory of the log files. Default is the folder of the -excuted script. log_dir can be a path as a character or it can be a function +executed script. log_dir can be a path as a character or it can be a function that takes the script path as input and returns the log directory. For more information see the examples of \code{run()} or \code{vignette('whirl')}. (Defaults to \code{dirname}, overwritable using option 'whirl.log_dir' or environment variable 'R_WHIRL_LOG_DIR')} -\item{n_workers}{Number of simultanous workers used in the run function. +\item{n_workers}{Number of simultaneous workers used in the run function. A maximum of 128 workers is allowed. (Defaults to \code{1}, overwritable using option 'whirl.n_workers' or environment variable 'R_WHIRL_N_WORKERS')} \item{execute_dir}{The working directory of the process executing each script. -Defeault us to execute R files from the working directory when calling \code{run()} +Default us to execute R files from the working directory when calling \code{run()} and all other functions from the directory of the script. To change provide a character path (used for all scripts) or a function that takes the script as input and returns the execution directory. (Defaults to \code{NULL}, overwritable using option 'whirl.execute_dir' or environment variable 'R_WHIRL_EXECUTE_DIR')} @@ -26,14 +26,14 @@ as input and returns the execution directory. (Defaults to \code{NULL}, overwrit \item{track_files}{Should files read and written be tracked? Currently only supported on Linux. (Defaults to \code{FALSE}, overwritable using option 'whirl.track_files' or environment variable 'R_WHIRL_TRACK_FILES')} -\item{out_formats}{Which log format(s) to produce. Possiblities are \code{html}, \code{json}, and +\item{out_formats}{Which log format(s) to produce. Possibilities are \code{html}, \code{json}, and markdown formats: \code{gfm}, \code{commonmark}, and \code{markua}. (Defaults to \code{"html"}, overwritable using option 'whirl.out_formats' or environment variable 'R_WHIRL_OUT_FORMATS')} \item{approved_pkgs_folder}{Approved folder library packages (Defaults to \code{NULL}, overwritable using option 'whirl.approved_pkgs_folder' or environment variable 'R_WHIRL_APPROVED_PKGS_FOLDER')} \item{check_renv}{Should the projects renv status be checked? (Defaults to \code{FALSE}, overwritable using option 'whirl.check_renv' or environment variable 'R_WHIRL_CHECK_RENV')} -\item{track_files_keep}{List of file naming patterns alway to be tracked when +\item{track_files_keep}{List of file naming patterns always to be tracked when track_files = TRUE (Defaults to \code{paste0("^", getwd())}, overwritable using option 'whirl.track_files_keep' or environment variable 'R_WHIRL_TRACK_FILES_KEEP')} \item{approved_pkgs_url}{Approved URL library packages (Defaults to \code{NULL}, overwritable using option 'whirl.approved_pkgs_url' or environment variable 'R_WHIRL_APPROVED_PKGS_URL')} diff --git a/man/run.Rd b/man/run.Rd index f785d60..fa67137 100644 --- a/man/run.Rd +++ b/man/run.Rd @@ -31,7 +31,7 @@ then all steps listed in the config file will be executed.} \item{summary_file}{A character string specifying the file path where the summary log will be stored.} -\item{n_workers}{Number of simultanous workers used in the run function. +\item{n_workers}{Number of simultaneous workers used in the run function. A maximum of 128 workers is allowed. (Defaults to \code{1}, overwritable using option 'whirl.n_workers' or environment variable 'R_WHIRL_N_WORKERS')} \item{check_renv}{Should the projects renv status be checked? (Defaults to \code{FALSE}, overwritable using option 'whirl.check_renv' or environment variable 'R_WHIRL_CHECK_RENV')} @@ -42,11 +42,11 @@ A maximum of 128 workers is allowed. (Defaults to \code{1}, overwritable using o \item{track_files}{Should files read and written be tracked? Currently only supported on Linux. (Defaults to \code{FALSE}, overwritable using option 'whirl.track_files' or environment variable 'R_WHIRL_TRACK_FILES')} -\item{out_formats}{Which log format(s) to produce. Possiblities are \code{html}, \code{json}, and +\item{out_formats}{Which log format(s) to produce. Possibilities are \code{html}, \code{json}, and markdown formats: \code{gfm}, \code{commonmark}, and \code{markua}. (Defaults to \code{"html"}, overwritable using option 'whirl.out_formats' or environment variable 'R_WHIRL_OUT_FORMATS')} \item{log_dir}{The output directory of the log files. Default is the folder of the -excuted script. log_dir can be a path as a character or it can be a function +executed script. log_dir can be a path as a character or it can be a function that takes the script path as input and returns the log directory. For more information see the examples of \code{run()} or \code{vignette('whirl')}. (Defaults to \code{dirname}, overwritable using option 'whirl.log_dir' or environment variable 'R_WHIRL_LOG_DIR')} } diff --git a/man/whirl-package.Rd b/man/whirl-package.Rd index 782e7a3..9d4fecb 100644 --- a/man/whirl-package.Rd +++ b/man/whirl-package.Rd @@ -8,7 +8,7 @@ \description{ \if{html}{\figure{logo.png}{options: style='float: right' alt='logo' width='120'}} -Provides functionalities for running R scripts in batch, while simultanously creating logs for each script execution. +Provides functionalities for running R scripts in batch, while simultaneously creating logs for each script execution. } \seealso{ Useful links: diff --git a/vignettes/whirl.Rmd b/vignettes/whirl.Rmd index a7a4dae..f73f88d 100644 --- a/vignettes/whirl.Rmd +++ b/vignettes/whirl.Rmd @@ -166,6 +166,6 @@ run( ) ``` -In this exampel the log of script1.R will be stored in **path/to/dir1/logs** and the log of script2.R will be stored in **path/to/dir2/logs**. +In this example the log of script1.R will be stored in **path/to/dir1/logs** and the log of script2.R will be stored in **path/to/dir2/logs**. Note that **x** refer to the path of the script that is being executed. From ef882decf417ed01e0ca622bee3ad32ec2235739 Mon Sep 17 00:00:00 2001 From: akselthomsen Date: Thu, 19 Dec 2024 10:15:46 +0100 Subject: [PATCH 05/14] fix: more linting issues --- .pre-commit-config.yaml | 4 ++-- R/custom_logging.R | 2 +- R/render_summary.R | 2 +- R/renv.R | 2 +- R/session.R | 22 +++++++--------------- R/strace.R | 3 ++- R/util_queue_summary.R | 2 +- R/whirl_queue.R | 15 ++++++++------- R/whirl_r_session.R | 4 ++-- inst/documents/dummy.qmd | 2 +- inst/documents/log.qmd | 2 +- tests/testthat/test-custom_logging.R | 4 ++-- 12 files changed, 29 insertions(+), 35 deletions(-) diff --git a/.pre-commit-config.yaml b/.pre-commit-config.yaml index d8ac1d4..167589a 100644 --- a/.pre-commit-config.yaml +++ b/.pre-commit-config.yaml @@ -4,8 +4,8 @@ repos: - repo: https://github.com/lorenzwalthert/precommit rev: v0.4.3.9003 hooks: - - id: style-files - args: [--style_pkg=styler, --style_fun=tidyverse_style] + # - id: style-files + # args: [--style_pkg=styler, --style_fun=tidyverse_style] - id: roxygenize additional_dependencies: - checkmate diff --git a/R/custom_logging.R b/R/custom_logging.R index 2874f87..cef202e 100644 --- a/R/custom_logging.R +++ b/R/custom_logging.R @@ -105,7 +105,7 @@ split_log <- function(log_df, types = c("read", "write", "delete")) { } #' @noRd -knit_print.whirl_log_info <- function(x, ...) { +knit_print.whirl_log_info <- function(x, ...) { # nolint x |> knitr::kable( row.names = FALSE diff --git a/R/render_summary.R b/R/render_summary.R index baa85bd..c5569eb 100644 --- a/R/render_summary.R +++ b/R/render_summary.R @@ -43,7 +43,7 @@ render_summary <- function(input, summary_file = "summary.html") { } #' @noRd -knit_print.whirl_summary_info <- function(x, path_rel_start, ...) { +knit_print.whirl_summary_info <- function(x, path_rel_start, ...) { # nolint hold <- x |> data.frame(check.names = FALSE) diff --git a/R/renv.R b/R/renv.R index 0c6b825..b6d3642 100644 --- a/R/renv.R +++ b/R/renv.R @@ -21,7 +21,7 @@ print.whirl_renv_status <- function(x, ...) { #' @noRd -knit_print.whirl_renv_status <- function(x, ...) { +knit_print.whirl_renv_status <- function(x, ...) { # nolint if (!length(x$status$lockfile$Packages)) { renv_note <- "warning" renv_title <- "renv not used" diff --git a/R/session.R b/R/session.R index 997e34f..99c6403 100644 --- a/R/session.R +++ b/R/session.R @@ -11,7 +11,7 @@ session_info <- function(approved_folder_pkgs = NULL, info <- sessioninfo::session_info() if (!is.null(approved_folder_pkgs) || - !is.null(approved_url_pkgs)) { + !is.null(approved_url_pkgs)) { info$packages <- check_approved( approved_pkg_folder = approved_folder_pkgs, approved_pkg_url = approved_url_pkgs, @@ -81,7 +81,6 @@ session_info <- function(approved_folder_pkgs = NULL, #' Get Python package info from json file #' #' @noRd - python_package_info <- function(json) { json <- jsonlite::fromJSON(json) @@ -105,15 +104,13 @@ python_package_info <- function(json) { } #' @noRd - -knit_print.whirl_session_info <- function(x, ...) { +knit_print.whirl_session_info <- function(x, ...) { # nolint x |> lapply(knitr::knit_print) } #' @noRd - -knit_print.whirl_platform_info <- function(x, ...) { +knit_print.whirl_platform_info <- function(x, ...) { # nolint data.frame( Setting = names(x), Value = x |> @@ -130,8 +127,7 @@ knit_print.whirl_platform_info <- function(x, ...) { } #' @noRd - -knit_print.whirl_packages_info <- function(x, ...) { +knit_print.whirl_packages_info <- function(x, ...) { # nolint if (!is.null(x$package)) { x <- data.frame( Package = x$package, @@ -152,8 +148,7 @@ knit_print.whirl_packages_info <- function(x, ...) { } #' @noRd - -knit_print.whirl_approved_pkgs <- function(x, ...) { +knit_print.whirl_approved_pkgs <- function(x, ...) { # nolint hold <- x |> data.frame( check.names = FALSE @@ -216,10 +211,7 @@ insert_at_intervals_df <- function(df, column_name, char_to_insert, interval) { } #' @noRd - - - -knit_print.whirl_environment_info <- function(x, ...) { +knit_print.whirl_environment_info <- function(x, ...) { # nolint dropped_info <- c( "BASH_FUNC", @@ -262,7 +254,7 @@ knit_print.whirl_environment_info <- function(x, ...) { } #' @noRd -knit_print.whirl_options_info <- function(x, ...) { +knit_print.whirl_options_info <- function(x, ...) { # nolint data.frame(t(sapply(unlist(x), c))) |> tidyr::pivot_longer(dplyr::everything(), values_to = "Value", diff --git a/R/strace.R b/R/strace.R index 3dc5fb5..9d273a8 100644 --- a/R/strace.R +++ b/R/strace.R @@ -214,7 +214,8 @@ refine_strace <- function(strace_df, # Remove delete when the file was created earlier, and not read before # that creation .data$type == "delete" & - (!cumsum(.data$type == "write") | utils::head(.data$type, 1) == "read") + (!cumsum(.data$type == "write") | + utils::head(.data$type, 1) == "read") ) |> dplyr::ungroup() |> dplyr::arrange(.data$seq, .data$file) |> diff --git a/R/util_queue_summary.R b/R/util_queue_summary.R index a98eecc..761c0a6 100644 --- a/R/util_queue_summary.R +++ b/R/util_queue_summary.R @@ -8,7 +8,7 @@ #' @noRd util_queue_summary <- function(queue_table) { if (!"result" %in% names(queue_table) || - !is.list(queue_table$result)) { + !is.list(queue_table$result)) { stop("queue_table must contain a list named 'result'") } diff --git a/R/whirl_queue.R b/R/whirl_queue.R index 44276ac..c4188e8 100644 --- a/R/whirl_queue.R +++ b/R/whirl_queue.R @@ -176,7 +176,7 @@ wq_add_queue <- function(self, private, scripts, tag, status) { if (is.character(private$log_dir)) { # Check if the directory exists if (!file.exists(private$log_dir)) { - cli::cli_abort("Logs cannot be saved because {.val {private$log_dir}} does not exist") + cli::cli_abort("Logs cannot be saved because {.val {private$log_dir}} does not exist") # nolint } folder <- file.path(private$log_dir) } else { @@ -185,7 +185,7 @@ wq_add_queue <- function(self, private, scripts, tag, status) { unique_folders <- unique(folder) if (any(!file.exists(unique_folders))) { missing <- unique_folders[!file.exists(unique_folders)] # nolint - cli::cli_abort("Logs cannot be saved because {.val {missing}} does not exist") + cli::cli_abort("Logs cannot be saved because {.val {missing}} does not exist") # nolint } } @@ -287,12 +287,13 @@ wq_next_step <- function(self, private, wid) { }, # Step 3: Finish log and create outputs "3" = { - purrr::pluck(private$.queue, "result", id_script) <- session$ + purrr::pluck(private$.queue, "result", id_script) <- + session$ log_finish()$ create_outputs( - out_dir = purrr::pluck(private$.queue, "log_dir", id_script), - format = private$out_formats - ) + out_dir = purrr::pluck(private$.queue, "log_dir", id_script), + format = private$out_formats + ) purrr::pluck(private$.queue, "status", id_script) <- purrr::pluck(private$.queue, "result", id_script, "status", "status") @@ -312,5 +313,5 @@ wq_next_step <- function(self, private, wid) { wq_run <- function(scripts, self) { self$ push(scripts)$ - wait() + wait() # nolint } diff --git a/R/whirl_r_session.R b/R/whirl_r_session.R index 11dc354..0da4799 100644 --- a/R/whirl_r_session.R +++ b/R/whirl_r_session.R @@ -111,7 +111,7 @@ whirl_r_session <- R6::R6Class( #' @param format [character] Output formats to create #' @return [invisible],[list] of logging information create_outputs = \(out_dir, - format = options::opt("out_formats", env = "whirl")) { + format = options::opt("out_formats", env = "whirl")) { wrs_create_outputs(out_dir, format, self, private, super) } ), @@ -259,7 +259,7 @@ wrs_log_script <- function(script, self, private, super) { } if (!file.exists(quarto_execute_dir)) { - cli::cli_abort("Script {.val {script}} cannot be run because execute directory {.val {quarto_execute_dir}} does not exist") + cli::cli_abort("Script {.val {script}} cannot be run because execute directory {.val {quarto_execute_dir}} does not exist") # nolint } # Execute the script diff --git a/inst/documents/dummy.qmd b/inst/documents/dummy.qmd index 82c9c8c..16b4735 100644 --- a/inst/documents/dummy.qmd +++ b/inst/documents/dummy.qmd @@ -79,7 +79,7 @@ saveRDS( ) if (is.character(params$renv) && params$renv == "yes" || - is.logical(params$renv) && params$renv) { + is.logical(params$renv) && params$renv) { saveRDS( object = whirl:::renv_status(), file = file.path(params$tmpdir, "renv_status.rds") diff --git a/inst/documents/log.qmd b/inst/documents/log.qmd index 0b2c1a3..7ce6d2c 100644 --- a/inst/documents/log.qmd +++ b/inst/documents/log.qmd @@ -165,7 +165,7 @@ info$python_packages cat("\n## R Packages\n") if (!is.null(params$check_approved_folder_pkgs) || - !is.null(params$check_approved_url_pkgs)) { + !is.null(params$check_approved_url_pkgs)) { whirl:::create_approval_plot(info$packages |> data.frame()) } diff --git a/tests/testthat/test-custom_logging.R b/tests/testthat/test-custom_logging.R index d59afa6..884deac 100644 --- a/tests/testthat/test-custom_logging.R +++ b/tests/testthat/test-custom_logging.R @@ -6,12 +6,12 @@ test_that("stream to console outside whirl context", { log_write("test_write") |> expect_output( - regexp = "\\{\"time\":\".*\",\"type\":\"write\",\"file\":\"test_write\"\\}" + regexp = "\\{\"time\":\".*\",\"type\":\"write\",\"file\":\"test_write\"\\}" # nolint ) log_delete("test_delete") |> expect_output( - regexp = "\\{\"time\":\".*\",\"type\":\"delete\",\"file\":\"test_delete\"\\}" + regexp = "\\{\"time\":\".*\",\"type\":\"delete\",\"file\":\"test_delete\"\\}" # nolint ) }) From 1b7d19a0dc51cbbaecf600a00f6fa7a309153249 Mon Sep 17 00:00:00 2001 From: akselthomsen Date: Fri, 20 Dec 2024 12:34:51 +0100 Subject: [PATCH 06/14] fix: checkov top-level permission should not be write-all --- .github/workflows/check_and_co.yaml | 3 +++ 1 file changed, 3 insertions(+) diff --git a/.github/workflows/check_and_co.yaml b/.github/workflows/check_and_co.yaml index 1fbdfdf..3d0a519 100644 --- a/.github/workflows/check_and_co.yaml +++ b/.github/workflows/check_and_co.yaml @@ -7,6 +7,9 @@ on: branches: - main - master + permissions: + contents: write + pull-requests: write name: All actions jobs: check-current-version: From 171f6742068c48292aaaae576bc8e2d1d40d0d4c Mon Sep 17 00:00:00 2001 From: akselthomsen Date: Fri, 20 Dec 2024 12:41:41 +0100 Subject: [PATCH 07/14] fix: indention --- .github/workflows/check_and_co.yaml | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/.github/workflows/check_and_co.yaml b/.github/workflows/check_and_co.yaml index 3d0a519..6f9140f 100644 --- a/.github/workflows/check_and_co.yaml +++ b/.github/workflows/check_and_co.yaml @@ -7,9 +7,9 @@ on: branches: - main - master - permissions: - contents: write - pull-requests: write +permissions: + contents: write + pull-requests: write name: All actions jobs: check-current-version: From 1ecd194d4c50ab8429e4112094251eddc0b07f6c Mon Sep 17 00:00:00 2001 From: akselthomsen Date: Fri, 20 Dec 2024 12:46:42 +0100 Subject: [PATCH 08/14] test: remove issue permission in the workflow --- .github/workflows/check_and_co.yaml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.github/workflows/check_and_co.yaml b/.github/workflows/check_and_co.yaml index 6f9140f..970dec4 100644 --- a/.github/workflows/check_and_co.yaml +++ b/.github/workflows/check_and_co.yaml @@ -36,4 +36,4 @@ jobs: use_local_setup_action: true megalinter: name: Megalinter - uses: NovoNordisk-OpenSource/r.workflows/.github/workflows/megalinter.yaml@main + uses: NovoNordisk-OpenSource/r.workflows/.github/workflows/megalinter.yaml@fix/permissions From 61e6e331a28b447c47994dc2ab3d960e5535f41c Mon Sep 17 00:00:00 2001 From: akselthomsen Date: Fri, 20 Dec 2024 14:48:44 +0100 Subject: [PATCH 09/14] fix: spelling and more wordlist --- R/render_summary.R | 4 ++-- inst/WORDLIST | 56 ++++++++++++++++++++++++++++++++++++++++++++-- 2 files changed, 56 insertions(+), 4 deletions(-) diff --git a/R/render_summary.R b/R/render_summary.R index c5569eb..e7c250c 100644 --- a/R/render_summary.R +++ b/R/render_summary.R @@ -1,11 +1,11 @@ -#' Render dataframe into a summary.html file +#' Render data.frame into a summary.html file #' #' @param input The input data.frame that should be rendered into a summary.html #' file #' @param summary_file A character string specifying the path where the summary #' HTML file should be saved. Defaults to `"summary.html"`. #' -#' @return Takes a dataframe as input and returns a log in html format +#' @return Takes a data.frame as input and returns a log in html format #' @noRd render_summary <- function(input, summary_file = "summary.html") { summary_qmd <- withr::local_tempfile( diff --git a/inst/WORDLIST b/inst/WORDLIST index 141a446..76c7616 100644 --- a/inst/WORDLIST +++ b/inst/WORDLIST @@ -1,74 +1,126 @@ Aksel +arning +asis aut callr Cervan cgid +chdir cli +colour commonmark +compats +Compats config Config cph +CRAN cre dev dir +dontrun dplyr +dset +ENOENT +ENOTDIR +envir +ENXIO Falgreen +Finalise +funct Gakava getenv getOption +getwd gfm ggplot +ggsave Girard github globbing +grepl +grpvar GxP +hjust https httr +initialise io jsonlite +kable kableExtra knitr Kristian ktqn +lapply +loadedversion Lovemore lvgk markua md +mdfmt +mdformats +multiarch +nchars +newname +nocov Nordisk +notangle Novo novonordisk NovoNordisk +nrow Obucina +openat opensource OpenSource overwritable -PKGS +pandoc +pkgload pkgs +PKGS pre purrr +rdname README renv RENV reticulate rlang +rlist rmarkdown -Roxygen roxygen +Roxygen +Roxygenize RoxygenNote +rstudio sessioninfo setenv sffl +skyblue Steffen +stopifnot stringr +succes +succesfully +Sweave Sys testthat Thomsen tibble tidyr +tmpf Troejelsgaard unglue +ungroup +unlist +urandom usethis +vctr +vctrs VignetteBuilder +vjust vlob +winslash withr yaml From 64afb32127308e0c67f5602baeb690acb97c5277 Mon Sep 17 00:00:00 2001 From: akselthomsen Date: Fri, 20 Dec 2024 14:59:41 +0100 Subject: [PATCH 10/14] add more words --- inst/WORDLIST | 14 ++++++++++++++ 1 file changed, 14 insertions(+) diff --git a/inst/WORDLIST b/inst/WORDLIST index 76c7616..fe0c5e4 100644 --- a/inst/WORDLIST +++ b/inst/WORDLIST @@ -1,7 +1,10 @@ + Aksel arning asis aut +autoupdate +callout callr Cervan cgid @@ -26,6 +29,7 @@ ENOTDIR envir ENXIO Falgreen +fileext Finalise funct Gakava @@ -53,6 +57,7 @@ knitr Kristian ktqn lapply +lintr loadedversion Lovemore lvgk @@ -76,15 +81,19 @@ opensource OpenSource overwritable pandoc +pkgdown pkgload pkgs PKGS +Posix pre purrr +Rbuildignore rdname README renv RENV +Renviron reticulate rlang rlist @@ -93,6 +102,7 @@ roxygen Roxygen Roxygenize RoxygenNote +Rproj rstudio sessioninfo setenv @@ -109,11 +119,14 @@ testthat Thomsen tibble tidyr +tidyverse +tmpdir tmpf Troejelsgaard unglue ungroup unlist +unnest urandom usethis vctr @@ -123,4 +136,5 @@ vjust vlob winslash withr +WORDLIST yaml From 5f5802b1fef4b682b52ed4d73495144b7a1ee19b Mon Sep 17 00:00:00 2001 From: akselthomsen Date: Fri, 20 Dec 2024 15:55:50 +0100 Subject: [PATCH 11/14] revert back to use new fixed main branch --- .github/workflows/check_and_co.yaml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.github/workflows/check_and_co.yaml b/.github/workflows/check_and_co.yaml index 970dec4..6f9140f 100644 --- a/.github/workflows/check_and_co.yaml +++ b/.github/workflows/check_and_co.yaml @@ -36,4 +36,4 @@ jobs: use_local_setup_action: true megalinter: name: Megalinter - uses: NovoNordisk-OpenSource/r.workflows/.github/workflows/megalinter.yaml@fix/permissions + uses: NovoNordisk-OpenSource/r.workflows/.github/workflows/megalinter.yaml@main From 034112956cb4d0358f77d73ec6b9bbf6e3c6cca0 Mon Sep 17 00:00:00 2001 From: akselthomsen Date: Thu, 16 Jan 2025 15:58:30 +0100 Subject: [PATCH 12/14] fix: duplicated test code --- tests/testthat/test-run.R | 67 +++++++++++++---------------- tests/testthat/test-strace.R | 83 ++++++++++-------------------------- 2 files changed, 52 insertions(+), 98 deletions(-) diff --git a/tests/testthat/test-run.R b/tests/testthat/test-run.R index b528955..a4a999d 100644 --- a/tests/testthat/test-run.R +++ b/tests/testthat/test-run.R @@ -1,14 +1,20 @@ +expect_single_script <- function(res) { + res[["status"]] |> + testthat::expect_equal("success") + + res[["result"]][[1]] |> + names() |> + testthat::expect_equal(c("status", "session_info_rlist", "log_details")) + + return(invisible(res)) +} + test_that("Run single R script", { res <- test_script("success.R") |> run() |> expect_no_condition() - res[["status"]] |> - expect_equal("success") - - res[["result"]][[1]] |> - names() |> - expect_equal(c("status", "session_info_rlist", "log_details")) + expect_single_script(res) }) test_that("Run single python script", { @@ -16,36 +22,37 @@ test_that("Run single python script", { run() |> expect_no_condition() - res[["status"]] |> - expect_equal("success") - - res[["result"]][[1]] |> - names() |> - expect_equal(c("status", "session_info_rlist", "log_details")) + expect_single_script(res) }) -test_that("Run multiple R scripts", { - res <- test_script(c("success.R", "warning.R", "error.R")) |> - run(n_workers = 2) |> - expect_no_error() - +expect_multiple_scripts <- function(res) { res[["status"]] |> - expect_equal(c("success", "warning", "error")) + testthat::expect_equal(c("success", "warning", "error")) res[["result"]][[1]][["status"]][c("error", "warning")] |> lapply(\(x) length(x) > 0) |> unlist() |> - expect_equal(c(FALSE, FALSE), ignore_attr = TRUE) + testthat::expect_equal(c(FALSE, FALSE), ignore_attr = TRUE) res[["result"]][[2]][["status"]][c("error", "warning")] |> lapply(\(x) length(x) > 0) |> unlist() |> - expect_equal(c(FALSE, TRUE), ignore_attr = TRUE) + testthat::expect_equal(c(FALSE, TRUE), ignore_attr = TRUE) res[["result"]][[3]][["status"]][c("error", "warning")] |> lapply(\(x) length(x) > 0) |> unlist() |> - expect_equal(c(TRUE, FALSE), ignore_attr = TRUE) + testthat::expect_equal(c(TRUE, FALSE), ignore_attr = TRUE) + + return(invisible(res)) +} + +test_that("Run multiple R scripts", { + res <- test_script(c("success.R", "warning.R", "error.R")) |> + run(n_workers = 2) |> + expect_no_error() + + expect_multiple_scripts(res) }) test_that("Run multiple python scripts", { @@ -53,23 +60,7 @@ test_that("Run multiple python scripts", { run(n_workers = 2) |> expect_no_error() - res[["status"]] |> - expect_equal(c("success", "warning", "error")) - - res[["result"]][[1]][["status"]][c("error", "warning")] |> - lapply(\(x) length(x) > 0) |> - unlist() |> - expect_equal(c(FALSE, FALSE), ignore_attr = TRUE) - - res[["result"]][[2]][["status"]][c("error", "warning")] |> - lapply(\(x) length(x) > 0) |> - unlist() |> - expect_equal(c(FALSE, TRUE), ignore_attr = TRUE) - - res[["result"]][[3]][["status"]][c("error", "warning")] |> - lapply(\(x) length(x) > 0) |> - unlist() |> - expect_equal(c(TRUE, FALSE), ignore_attr = TRUE) + expect_multiple_scripts(res) }) test_that("Run yaml config file", { diff --git a/tests/testthat/test-strace.R b/tests/testthat/test-strace.R index 02ef7db..0e2f16e 100644 --- a/tests/testthat/test-strace.R +++ b/tests/testthat/test-strace.R @@ -1,3 +1,22 @@ +expect_strace <- function(read, delete, write, path = "strace.log") { + + strace_info <- read_strace_info( + path = path, + p_wd = getwd(), + strace_discards = options::opt("track_files_discards"), + strace_keep = getwd() + ) + + strace_info$read$file |> + testthat::expect_match(read) + + strace_info$delete$file |> + testthat::expect_match(delete) + + strace_info$write$file |> + testthat::expect_match(write) +} + test_that("strace works", { skip_on_ci() skip_on_os(c("windows", "mac", "solaris")) @@ -14,81 +33,25 @@ test_that("strace works", { p$run(\() 1 + 1) - strace_info <- read_strace_info( - path = "strace.log", - p_wd = getwd(), - strace_discards = options::opt("track_files_discards"), - strace_keep = getwd() - ) - - strace_info$read$file |> - expect_equal("No files") - - strace_info$delete$file |> - expect_equal("No files") - - strace_info$write$file |> - expect_equal("No files") + expect_strace("^No files$", "^No files$", "^No files$") # Only save a file p$run(\() saveRDS(object = mtcars, file = "mtcars.rds")) - strace_info <- read_strace_info( - path = "strace.log", - p_wd = getwd(), - strace_discards = options::opt("track_files_discards"), - strace_keep = getwd() - ) - - strace_info$read$file |> - expect_equal("No files") - - strace_info$delete$file |> - expect_equal("No files") - - strace_info$write$file |> - expect_match("/mtcars.rds$") + expect_strace("^No files$", "^No files$", "/mtcars.rds$") # Also read dummy.txt p$run(\() readLines("dummy.txt")) - strace_info <- read_strace_info( - path = "strace.log", - p_wd = getwd(), - strace_discards = options::opt("track_files_discards"), - strace_keep = getwd() - ) - - strace_info$read$file |> - expect_match("/dummy.txt$") - - strace_info$delete$file |> - expect_equal("No files") - - strace_info$write$file |> - expect_match("/mtcars.rds$") + expect_strace("/dummy.txt$", "^No files$", "/mtcars.rds$") # Finally delete read dummy.txt p$run(\() file.remove("dummy.txt")) - strace_info <- read_strace_info( - path = "strace.log", - p_wd = getwd(), - strace_discards = options::opt("track_files_discards"), - strace_keep = getwd() - ) - - strace_info$read$file |> - expect_match("/dummy.txt$") - - strace_info$delete$file |> - expect_match("/dummy.txt$") - - strace_info$write$file |> - expect_match("/mtcars.rds$") + expect_strace("/dummy.txt$", "/dummy.txt$", "/mtcars.rds$") p$kill() p$finalize() From 916fe03842ee3fd736a95fefe038e8eb69f84b3f Mon Sep 17 00:00:00 2001 From: akselthomsen Date: Thu, 16 Jan 2025 16:11:50 +0100 Subject: [PATCH 13/14] fix: move still relevant todos to issue #129 --- R/session.R | 4 ---- R/whirl_r_session.R | 2 -- 2 files changed, 6 deletions(-) diff --git a/R/session.R b/R/session.R index 99c6403..7504efa 100644 --- a/R/session.R +++ b/R/session.R @@ -33,7 +33,6 @@ session_info <- function(approved_folder_pkgs = NULL, info$options <- info$options[!names(info$options) %in% "rl_word_breaks"] class(info$options) <- c("options_info", class(info$options)) - # TODO: Extend to also cover external. info[!names(info) %in% c("platform", "packages", "environment", "options")] <- NULL @@ -52,9 +51,6 @@ session_info <- function(approved_folder_pkgs = NULL, } if (!is.null(python_packages)) { - # TODO: Get the same information as for R packages - # (not only name and version) - # TODO: Only show used, and not all installed, packages if possible info$python_packages <- python_packages class(info$python_packages) <- c( diff --git a/R/whirl_r_session.R b/R/whirl_r_session.R index 0da4799..b198074 100644 --- a/R/whirl_r_session.R +++ b/R/whirl_r_session.R @@ -138,8 +138,6 @@ wrs_initialize <- function(verbosity_level, check_renv, track_files, self, private, super) { super$initialize() # uses callr::r_session$initialize() - # TODO: Is there a way to use `.local_envir` to avoid having to clean up the - # temp dir in finalize? private$wd <- withr::local_tempdir(clean = FALSE) private$verbosity_level <- verbosity_level private$check_renv <- check_renv From 605911ee98ad92f0985ba10d4755235632bea96f Mon Sep 17 00:00:00 2001 From: akselthomsen Date: Thu, 16 Jan 2025 16:25:11 +0100 Subject: [PATCH 14/14] temp fix: use old zephyr version. upgrade to CRAN in #130 --- DESCRIPTION | 2 +- inst/WORDLIST | 3 ++- 2 files changed, 3 insertions(+), 2 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index 864ad01..cbf4192 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -47,7 +47,7 @@ Suggests: testthat (>= 3.0.0), usethis Remotes: - NovoNordisk-OpenSource/zephyr + NovoNordisk-OpenSource/zephyr@a4d5163108e2c4042f98bd00f17f1af7353b08c2 Config/testthat/edition: 3 Encoding: UTF-8 Roxygen: list(markdown = TRUE) diff --git a/inst/WORDLIST b/inst/WORDLIST index fe0c5e4..c677153 100644 --- a/inst/WORDLIST +++ b/inst/WORDLIST @@ -1,9 +1,10 @@ - +af Aksel arning asis aut autoupdate +bd callout callr Cervan