Enable whirl::run to execute python scripts (#116)

* feat: Execute and log execution of python scripts
* feat: add python version and packages to log
* ci: install jupyter
* feat: include python unit test
* fix: don't display system.file to the user
* feat: make example run in pkgdown and R CMD check

---------

Signed-off-by: Aksel Thomsen <[email protected]>
Co-authored-by: WYMZ (Michael Svingel) <[email protected]>
Co-authored-by: CGID (Cervan Girard) <[email protected]>

.github/actions/setup/action.yaml

@@ -8,5 +8,21 @@ runs:
       shell: bash
       run: |
         echo 0 | sudo tee /proc/sys/kernel/yama/ptrace_scope
+
     - name: Install Quarto
       uses: quarto-dev/quarto-actions/setup@v2
+
+    - name: (Linux) Install jupyter
+      if: runner.os == 'Linux'
+      shell: bash
+      run: python3 -m pip install jupyter
+
+    - name: (macOS) Install jupyter
+      if: runner.os == 'macOS'
+      shell: bash
+      run: python3 -m pip install --break-system-packages jupyter
+
+    - name: (Windows) Install jupyter
+      if: runner.os == 'Windows'
+      shell: bash
+      run: py -m pip install jupyter

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: whirl
 Title: Logging package
-Version: 0.1.5
+Version: 0.1.5.9000
 Authors@R: c(
     person("Aksel", "Thomsen", , "[email protected]", role = c("aut", "cre")),
     person("Lovemore", "Gakava", , "[email protected]", role = "aut"),
@@ -41,7 +41,8 @@ Imports:
     withr,
     yaml,
     zephyr (>= 0.0.0.9000),
-    glue
+    glue,
+    reticulate
 Suggests: 
     testthat (>= 3.0.0),
     usethis

NAMESPACE

@@ -8,3 +8,4 @@ export(use_whirl)
 importFrom(R6,R6Class)
 importFrom(callr,r_session)
 importFrom(dplyr,.data)
+importFrom(reticulate,py)

NEWS.md

@@ -1,3 +1,7 @@
+# whirl dev
+* Added support for logging of Python scripts with `run()`.
+* Improved unit tests for `run()`
+
 # whirl 0.1.4 (2024-11-01)
 * Add `use_whirl()` utility function.
 

R/internal_run.R

@@ -37,11 +37,11 @@ internal_run <- function(input, steps, queue, level,
       internal_run(input = files,
                    steps = steps,
                    queue = queue,
-                   level = level + 1)
+                   level = level + 1,
+                   verbosity_level = verbosity_level)
     } else {
       # Execute the scripts
       result <- queue$run(files)
-      cat("\n")
     }
   }
 

R/render_summary.R

@@ -50,15 +50,12 @@ knit_print.whirl_summary_info <- function(x, path_rel_start, ...) {
   ncols <- ncol(hold)
 
   if (grepl("rstudio_cloud", Sys.getenv("R_CONFIG_ACTIVE"))) {
-    hold <- hold |> dplyr::mutate(formated = file.path("/file_show?path=", .data[["Hyperlink"]]))
+    formatted <- file.path("/file_show?path=", hold[["Hyperlink"]])
   } else {
-    hold <- hold |> dplyr::mutate(formated = file.path(path_rel(.data[["Hyperlink"]], start = path_rel_start)))
+    formatted <- file.path(path_rel(hold[["Hyperlink"]], start = path_rel_start))
   }
 
-  hold$Hyperlink <- paste0(sprintf('<a href="%s" target="_blank">%s</a>', hold$formated, "HTML Log"))
-
-  hold <- hold |>
-    dplyr::select(-.data[["formated"]])
+  hold$Hyperlink <- paste0(sprintf('<a href="%s" target="_blank">%s</a>', formatted, "HTML Log"))
 
   knitr::kable(hold, format = "html", escape = FALSE) |>
     kableExtra::column_spec(1:ncols, background = ifelse(

R/run.R

@@ -21,20 +21,27 @@
 #' @inheritParams options_params
 #' @return A tibble containing the execution results for all the scripts.
 #'
-#'@examplesIf FALSE
+
+#'@examples
+#' # Start by copying the following three example scripts:
+#' file.copy(
+#'   from = system.file("examples", c("success.R", "warning.R", "error.R"), package = "whirl"),
+#'   to = "."
+#'   )
 #'
 #' # Run a single script
-#' script <- system.file("examples/simple/success.R", package = "whirl")
-#' run(script)
+#' run("success.R")
 #'
 #' # Run several scripts in parallel on up to 2 workers
-#' scripts <- system.file("examples/simple", c("success.R", "warning.R", "error.R"), package = "whirl")
-#' run(scripts, n_workers = 2)
+#' run(c("success.R", "warning.R", "error.R"), n_workers = 2)
 #'
-#' # Run scripts in several steps
-#' step_1 <- system.file("examples/simple", c("success.R", "warning.R"), package = "whirl")
-#' step_2 <- system.file("examples/simple", c("error.R"), package = "whirl")
-#' run(list(step_1, step_2), n_workers = 2)
+#' # Run scripts in two steps by providing them as list elements
+#' run(
+#'   list(
+#'     c("success.R", "warning.R"),
+#'     "error.R"
+#'     ),
+#'    n_workers = 2)
 #'
 #' @export
 
@@ -55,21 +62,31 @@ run <- function(input,
   approved_pkgs_url = options::opt("approved_pkgs_url", env = "whirl")
 
   # Message when initiating
-  d <- cli::cli_div(theme = list(rule = list(
-    color = "skyblue3", "line-type" = "double"
-  )))
-
-  zephyr::msg("Executing scripts and generating logs",
-              levels_to_write = c("verbose", "minimal"),
+  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 = cli::cli_rule)
+              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("End of process",
-                      levels_to_write = c("verbose", "minimal"),
-                      verbosity_level = verbosity_level,
-                      msg_fun = cli::cli_rule))
-  on.exit(cli::cli_end(d), add = TRUE)
+  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)
+                  }
+                )
+  })
 
   # Constrain the number of workers
   n_workers <- min(128, n_workers)
@@ -96,9 +113,12 @@ run <- function(input,
                          level = 1,
                          verbosity_level = verbosity_level)
 
-  # Create the summary log
-  summary_tibble <- util_queue_summary(result$queue)
-  render_summary(input = summary_tibble, summary_file = summary_file)
+  # 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)
 

R/session.R

@@ -1,10 +1,11 @@
 #' Get session info
 #'
 #' Retrieve session info and add quarto info if not already there
+#' Argument to also add python version and package info
 #'
 #' @noRd
 
-session_info <- function(approved_folder_pkgs, approved_url_pkgs) {
+session_info <- function(approved_folder_pkgs = NULL, approved_url_pkgs = NULL, python_packages = NULL) {
   info <- sessioninfo::session_info()
 
   if (!is.null(approved_folder_pkgs) |
@@ -30,7 +31,7 @@ session_info <- function(approved_folder_pkgs, approved_url_pkgs) {
   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 and python below in methods.
+  # TODO: Extend to also cover external.
   info[!names(info) %in% c("platform", "packages", "environment", "options")] <- NULL
 
   if (is.null(info$platform$quarto)) {
@@ -44,6 +45,19 @@ session_info <- function(approved_folder_pkgs, approved_url_pkgs) {
     }
   }
 
+  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("packages_info", class(info$python_packages))
+
+    quarto_python_path <- Sys.getenv("QUARTO_PYTHON")
+    quarto_python_version <- gsub(".*/([0-9]+\\.[0-9]+\\.[0-9]+)/.*", "\\1", quarto_python_path)
+    info$platform$python <- quarto_python_version
+  }
+
   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]]))
@@ -52,6 +66,21 @@ session_info <- function(approved_folder_pkgs, approved_url_pkgs) {
   return(info)
 }
 
+#' Get Python package info from json file
+#'
+#' @noRd
+
+python_package_info <- function(json) {
+
+  json |>
+    jsonlite::fromJSON() |>
+    tibble::enframe(name = "Package") |>
+    tidyr::unnest_wider(col = "value") |>
+    dplyr::rename(
+      Version = "version",
+      Path = "installation_path"
+    )
+}
 
 #' @noRd
 
@@ -81,13 +110,18 @@ knit_print.whirl_platform_info <- function(x, ...) {
 #' @noRd
 
 knit_print.whirl_packages_info <- function(x, ...) {
-  data.frame(
-    Package = x$package,
-    Version = x$loadedversion,
-    `Date (UTC)` = x$date,
-    Source = x$source,
-    check.names = FALSE
-  ) |>
+
+  if (!is.null(x$package)){
+    x <- data.frame(
+      Package = x$package,
+      Version = x$loadedversion,
+      `Date (UTC)` = x$date,
+      Source = x$source,
+      check.names = FALSE
+    )
+  }
+
+  x |>
     knitr::kable() |>
     kableExtra::kable_styling(
       bootstrap_options = "striped",
@@ -97,7 +131,7 @@ knit_print.whirl_packages_info <- function(x, ...) {
 }
 
 #' @noRd
-#'
+
 knit_print.whirl_approved_pkgs <- function(x, ...) {
   hold <- x |>
     data.frame(

R/status.R

@@ -11,13 +11,27 @@ get_status <- function(md) {
 
   x <- x[[1]]
 
+  add_python <- x |>
+    stringr::str_detect("\\{.python .cell-code") |>
+    any()
+
   # Errors
 
   errors <- x |>
     stringr::str_subset(pattern = "^ *\\{\\.cell-output \\.cell-output-error\\}") |>
     stringr::str_remove_all("\\{[^\\}]*\\}") |>
     stringr::str_squish()
 
+  if (add_python) {
+    python_errors <- x |>
+      stringr::str_subset(pattern = "^ *\\{\\.cell-output") |>
+      stringr::str_remove_all("\\{[^\\}]*\\}") |>
+      stringr::str_squish() |>
+      stringr::str_subset("Error:")
+
+    errors <- c(errors, python_errors)
+  }
+
   # Warnings
 
   warnings <- x |>
@@ -26,6 +40,16 @@ get_status <- function(md) {
     stringr::str_squish() |>
     stringr::str_subset(pattern = "^(W|w)arning")
 
+  if (add_python) {
+    python_warnings <- x |>
+      stringr::str_subset(pattern = "^ *\\{\\.cell-output") |>
+      stringr::str_remove_all("\\{[^\\}]*\\}") |>
+      stringr::str_squish() |>
+      stringr::str_subset("Warning:")
+
+    warnings <- c(warnings, python_warnings)
+  }
+
   # Status
 
   if (length(errors)) {

R/utils.R

@@ -5,7 +5,7 @@ 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, "", tail(file_parts, 1))
+      file_extension <- ifelse(length(file_parts) == 1, "", utils::tail(file_parts, 1))
       return(file_extension)
     },
     FUN.VALUE = character(1),

R/whirl-package.R

@@ -1,5 +1,6 @@
 ## usethis namespace: start
 #' @importFrom dplyr .data
+#' @importFrom reticulate py
 ## usethis namespace: end
 NULL