Feat/log folder

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: whirl
 Title: Logging package
-Version: 0.1.6.9000
+Version: 0.1.6.9001
 Authors@R: c(
     person("Aksel", "Thomsen", , "[email protected]", role = c("aut", "cre")),
     person("Lovemore", "Gakava", , "[email protected]", role = "aut"),

NEWS.md

@@ -1,4 +1,5 @@
 # whirl (development version)
+* 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. 
 * Fixed a bug where the hyperlink in the summary files was not rendered correctly.
 

R/custom_logging.R

@@ -6,7 +6,7 @@
 #' 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 aoperations
+#' 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

R/options.R

@@ -82,3 +82,10 @@ options::define_option(
   default = 1,
   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')`."
+)
+

R/run.R

@@ -43,6 +43,19 @@
 #'     ),
 #'    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
+#'
+#' # 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")})
+#'
 #' @export
 
 run <- function(input,
@@ -52,7 +65,8 @@ run <- function(input,
                 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")
+                out_formats = options::opt("out_formats", env = "whirl"),
+                log_dir = options::opt("log_dir", env = "whirl")
                 ) {
 
   # Additional Settings
@@ -105,7 +119,8 @@ run <- function(input,
                            track_files_discards = track_files_discards,
                            track_files_keep = track_files_keep,
                            approved_pkgs_folder = approved_pkgs_folder,
-                           approved_pkgs_url = approved_pkgs_url)
+                           approved_pkgs_url = approved_pkgs_url,
+                           log_dir = log_dir)
 
   result <- internal_run(input = input,
                          steps = steps,

R/whirl_queue.R

@@ -23,7 +23,8 @@ whirl_queue <- R6::R6Class(
                    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")
+                   approved_pkgs_url = options::opt("approved_pkgs_url", env = "whirl"),
+                   log_dir = options::opt("log_dir", env = "whirl")
                    ) {
       wq_initialise(self, private,
                     n_workers,
@@ -34,7 +35,8 @@ whirl_queue <- R6::R6Class(
                     track_files_discards,
                     track_files_keep,
                     approved_pkgs_folder,
-                    approved_pkgs_url)
+                    approved_pkgs_url,
+                    log_dir)
     },
 
     #' @description Push scripts to the queue
@@ -122,14 +124,15 @@ whirl_queue <- R6::R6Class(
     track_files_discards = NULL,
     track_files_keep = NULL,
     approved_pkgs_folder = NULL,
-    approved_pkgs_url = NULL
+    approved_pkgs_url = NULL,
+    log_dir = NULL
   )
 )
 
 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) {
+                          approved_pkgs_folder, approved_pkgs_url, log_dir) {
 
   private$check_renv <- check_renv
   private$verbosity_level <- verbosity_level
@@ -139,13 +142,15 @@ wq_initialise <- function(self, private, n_workers,
   private$track_files_keep <- track_files_keep
   private$approved_pkgs_folder <- approved_pkgs_folder
   private$approved_pkgs_url <- approved_pkgs_url
+  private$log_dir <- log_dir
 
   private$.queue <- tibble::tibble(
     id = numeric(),
     tag = character(),
     script = character(),
     status = character(),
-    result = list()
+    result = list(),
+    log_dir = character()
   )
 
   private$.workers <- tibble::tibble(
@@ -159,12 +164,32 @@ wq_initialise <- function(self, private, n_workers,
 
 wq_add_queue <- function(self, private, scripts, tag, status) {
 
+  #Adding the log directory to the queue
+  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")
+    }
+    folder <- file.path(private$log_dir)
+
+  } else {
+
+    folder <- private$log_dir(scripts)
+    #Check if the directory exists
+    unique_folders <- unique(folder)
+    if (any(!file.exists(unique_folders))) {
+      missing <- unique_folders[!file.exists(unique_folders)]
+      cli::cli_abort("Logs cannot be saved because {.val {missing}} does not exist")
+    }
+  }
+
   private$.queue <- self$queue |>
     tibble::add_row(
       id = nrow(self$queue) + seq_along(scripts),
       tag = tag,
       script = scripts,
-      status = status
+      status = status,
+      log_dir = folder
     )
   return(invisible(self))
 }
@@ -180,7 +205,7 @@ wq_skip <- function(self, private, scripts, tag) {
 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) {
+                    approved_pkgs_folder, approved_pkgs_url, log_dir) {
 
   # Start new sessions if there are available workers and waiting scripts in the queue
 
@@ -196,7 +221,8 @@ wq_poll <- function(self, private, timeout,
                                  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),
+                                 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
@@ -251,7 +277,7 @@ wq_next_step <- function(self, private, wid) {
           "3" = {
             purrr::pluck(private$.queue, "result", id_script) <- session$
               log_finish()$
-              create_outputs(out_dir = dirname(purrr::pluck(private$.queue, "script", id_script)),
+              create_outputs(out_dir = purrr::pluck(private$.queue, "log_dir", id_script),
                              format = private$out_formats)
 
             purrr::pluck(private$.queue, "status", id_script) <-

R/whirl_r_session.R

@@ -19,7 +19,8 @@ whirl_r_session <- R6::R6Class(
                    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")
+                   approved_pkgs_url = options::opt("approved_pkgs_url", env = "whirl"),
+                   log_dir = options::opt("log_dir", env = "whirl")
                    ) {
         wrs_initialize(verbosity_level,
                        check_renv,
@@ -29,6 +30,7 @@ whirl_r_session <- R6::R6Class(
                        track_files_keep,
                        approved_pkgs_folder,
                        approved_pkgs_url,
+                       log_dir,
                        self, private, super)
     },
 
@@ -109,6 +111,7 @@ whirl_r_session <- R6::R6Class(
     wd = NULL,
     track_files = NULL,
     out_formats = NULL,
+    log_dir = NULL,
     track_files_discards = NULL,
     track_files_keep = NULL,
     approved_pkgs_folder = NULL,
@@ -122,7 +125,7 @@ whirl_r_session <- R6::R6Class(
 
 wrs_initialize <- function(verbosity_level, check_renv, track_files,
                            out_formats, track_files_discards, track_files_keep,
-                           approved_pkgs_folder, approved_pkgs_url,
+                           approved_pkgs_folder, approved_pkgs_url, log_dir,
                            self, private, super) {
 
   super$initialize() # uses callr::r_session$initialize()
@@ -137,6 +140,7 @@ wrs_initialize <- function(verbosity_level, check_renv, track_files,
   private$track_files_keep <- track_files_keep
   private$approved_pkgs_folder <- approved_pkgs_folder
   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 (private$verbosity_level == "verbose" && !cli::is_dynamic_tty()) {

tests/testthat/test-run.R

@@ -85,3 +85,38 @@ test_that("Run yaml config file", {
     expect_no_error()
 
 })
+
+
+test_that("Change the log_dir to a path", {
+  #Custom path
+  custom_path <- withr::local_tempdir()
+
+  #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
+  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 <- 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
+  res <- file.path(custom_path, "warning.R") |>
+    run(log_dir = function(x) {paste0(dirname(x), "/logs")}) |>
+    expect_no_error()
+
+  #Check if the log file is created in the correct folder
+  file.path(custom_path, "logs", "warning_log.html") |>
+    file.exists() |>
+    expect_true()
+})
+

vignettes/whirl.Rmd

@@ -21,7 +21,7 @@ The whirl package provides functionalities for executing scripts in batch while
 
 # Ways to call the `run()` function
 
-## Single and multiple files, and regular expressions
+## Single and multiple files, and wild cards
 
 The `input` argument in the `run()` function can in the most simple case point to a single file for which an execution and log-generation is required. 
 
@@ -52,9 +52,9 @@ run(
 )
 ```
 
-More information on how the wildcards are interpreted see `utils::glob2rx()`.
+More information on how the wildcards are interpreted see `Sys.glob()`.
 
-It is also possible to provide a character vector of several paths (either single files or regular expression) that should be executed. Note that whenever the `input` argument in is supplied with a character vector (e.g. `c("path/to/script1.R", "path/to/script2.R")`) it assumes that these can be executed independently and in parallel. If the elements needs to be executed sequentially this can be achieved by using a `list()` instead (see below).
+It is also possible to provide a character vector of several paths (either single files or glob expression) that should be executed. Note that whenever the `input` argument in is supplied with a character vector (e.g. `c("path/to/script1.R", "path/to/script2.R")`) it assumes that these can be executed independently and in parallel. If the elements needs to be executed sequentially this can be achieved by using a `list()` instead (see below).
 
 ## Using `list()` as input
 
@@ -133,3 +133,32 @@ run(input = "path/to/config.yaml", n_workers = 4)
 ```
 
 Each steps in the config file will be executed independently while scrips within each step will be executed in parallel using the number of workers specified with the `n_workers` argument.
+
+# Adjusting the log directory
+## How to use the `log_dir` argument to specify where to store the logs
+When executing `run()` the default is to store logs in the directory where the individual scripts are located. For example, if we apply `run()` to a a vector of scripts with the following paths `c(path/to/dir1/script1.R, path/to/dir2/script2.R)`, the log of script1.R and script2.R will be stored in **path/to/dir1** and **path/to/dir2**, respectively.
+
+If the logs should be stored in a different directory, the `log_dir` argument can be used. 
+This argument can be supplied with a character string or a function. Note that in either case the directory that `log_dir` points to must exist before the execution is initiated.  
+
+If the `log_dir` is supplied with a character pointing to a specific path the call could look like:
+
+```{r}
+run(input = "path/to/script.R", log_dir = "path/to/logs")
+```
+
+In this example the log of script.R will be stored in **path/to/logs**.  
+Note that if multiple scripts are executed and `log_dir` is a character to a path, then every log will be redirected to the same directory - in this case **path/to/logs**.
+
+
+If a more dynamic approach is needed the `log_dir` argument can also be supplied with a function that will be applied to the individual path of every script.  
+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")})
+```
+
+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**.
+
+Note that **x** refer to the path of the script that is being executed.