Add a function to "purl" qmd to R script: qmd_to_r_script() (#266)

* Add extract_r_code feature

* check for no cell and non supported cells

* Add quiet to add_spin_preamble

* Inform about mixed language input

* Add internal helper to create preamble

* error on existing R script file

* document the new function and export

* rename to qmd_to_r_script and mark as experimental

* Add to pkgdown function list

* Add NEWS and bump version

* Add vignette to show the feature

Author: cderv

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: quarto
 Title: R Interface to 'Quarto' Markdown Publishing System
-Version: 1.4.4.9023
+Version: 1.4.4.9024
 Authors@R: c(
     person("JJ", "Allaire", , "[email protected]", role = "aut",
            comment = c(ORCID = "0000-0003-0174-9868")),

NAMESPACE

@@ -4,6 +4,7 @@ export(add_spin_preamble)
 export(check_newer_version)
 export(is_using_quarto)
 export(new_blog_post)
+export(qmd_to_r_script)
 export(quarto_add_extension)
 export(quarto_available)
 export(quarto_binary_sitrep)

NEWS.md

@@ -4,6 +4,8 @@
 
 - Added NA value detection in YAML processing to prevent silent failures when passing R's `NA` values to Quarto CLI. Functions `as_yaml()` and `write_yaml()` now validate for NA values and provide clear error messages with actionable suggestions. This addresses issues where R's `NA` values get converted to YAML strings (like `.na.real`) that Quarto doesn't recognize as missing values, because they are not supported in YAML 1.2 spec. This is to help users handle missing data appropriately before passing to Quarto (#168).
 
+- Added `qmd_to_r_script()` function to extract R code cells from Quarto documents and create R scripts. This experimental function preserves chunk options using `#|` syntax, adds YAML metadata as spin-style headers, and handles mixed-language documents by filtering only R cells. Complements the existing `add_spin_preamble()` function for working with R scripts in Quarto workflows (#208, quarto-dev/quarto-cli#9112).
+
 - Added `add_spin_preamble()` function to add YAML preambles to R scripts for use with Quarto Script rendering support. The function automatically detects existing preambles and provides flexible customization options through `title` and `preamble` parameters (#164).
 
 - `quarto_create_project()` gains a `title` argument to set the project title independently from the directory name. This allows creating projects with custom titles, including when using `name = "."` to create a project in the current directory (thanks, @davidkane9, #148). This matches with `--title` addition for `quarto create project` in Quarto CLI v1.5.15.

R/spin.R

@@ -27,6 +27,7 @@
 #'   in the `preamble` list. If NULL, uses `preamble$title` or filename as fallback.
 #' @param preamble Named list of YAML metadata to include in preamble.
 #'   The `title` parameter takes precedence over `preamble$title` if both are provided.
+#' @param quiet If `TRUE`, suppresses messages and warnings.
 #' @return Invisibly returns the script path if modified, otherwise invisible NULL
 #'
 #' @examples
@@ -55,22 +56,31 @@
 #' )
 #' }
 #' @export
-add_spin_preamble <- function(script, title = NULL, preamble = NULL) {
+add_spin_preamble <- function(
+  script,
+  title = NULL,
+  preamble = NULL,
+  quiet = FALSE
+) {
   if (!fs::file_exists(script)) {
-    cli::cli_abort(c(
-      "File {.file {script}} does not exist.",
-      "Please provide a valid file path."
-    ))
+    cli::cli_abort(
+      c(
+        "File {.file {script}} does not exist.",
+        "Please provide a valid file path."
+      )
+    )
   }
 
   content <- xfun::read_utf8(script)
 
   # if files starts with a spin preamble, do nothing
   if (grepl("^\\s*#'", content[1])) {
-    cli::cli_inform(c(
-      "File {.file {script}} already has a spin preamble.",
-      "No changes made. Edit manually if needed."
-    ))
+    if (isFALSE(quiet)) {
+      cli::cli_inform(c(
+        "File {.file {script}} already has a spin preamble.",
+        "No changes made. Edit manually if needed."
+      ))
+    }
     return(invisible())
   }
 
@@ -93,14 +103,40 @@ add_spin_preamble <- function(script, title = NULL, preamble = NULL) {
     metadata$title <- fs::path_file(fs::path_ext_remove(script))
   }
 
-  preamble_text <- paste(
-    "#'",
-    xfun::split_lines(as_yaml_block(metadata))
-  )
+  preamble_text <- create_header_preamble(metadata)
 
   new_content <- c(preamble_text, "", content)
   xfun::write_utf8(new_content, con = script)
 
-  cli::cli_inform("Added spin preamble to {.file {script}}")
+  if (isFALSE(quiet)) {
+    cli::cli_inform(c(
+      "Added spin preamble to {.file {script}}."
+    ))
+  }
   return(invisible(script))
 }
+
+create_header_preamble <- function(metadata) {
+  if (length(metadata) == 0) {
+    return("")
+  }
+  build_preamble("#'", as_yaml_block(metadata))
+}
+
+create_code_preamble <- function(metadata) {
+  if (length(metadata) == 0) {
+    return("")
+  }
+  # Remove trailing newline for this block as `as_yaml` adds one
+  build_preamble("#|", sub("\n$", "", as_yaml(metadata)))
+}
+
+build_preamble <- function(prepend, content) {
+  if (!nzchar(content)) {
+    return("")
+  }
+  paste(
+    prepend,
+    xfun::split_lines(content)
+  )
+}

R/utils-extract.R

@@ -0,0 +1,127 @@
+#' Convert Quarto document to R script
+#'
+#' @description
+#' `r lifecycle::badge("experimental")`
+#'
+#' Extracts R code cells from a Quarto document and writes them to an R script
+#' file that can be rendered with the same options. The Markdown text is not
+#' preserved, but R chunk options are kept as comment headers using Quarto's
+#' `#|` syntax.
+#'
+#' This function is still experimental and may slightly change in
+#' future releases, depending on feedback.
+#'
+#' @param qmd Character. Path to the input Quarto document (.qmd file).
+#' @param script Character. Path to the output R script file. If `NULL`
+#'   (default), the script file will have the same name as the input file
+#'   but with `.R` extension.
+#'
+#' @details
+#' This function processes a Quarto document by:
+#' - Extracting only R code cells (markdown and cell in other languages are ignored)
+#' - Preserving chunk options as `#|` comment headers
+#' - Adding the document's YAML metadata as a spin-style header
+#' - Creating an R script that can be rendered with the same options
+#'
+#' ## File handling:
+#' - If the output R script already exists, the function will abort with an error
+#' - Non-R code cells (e.g., Python, Julia, Observable JS) are ignored
+#' - If no R code cells are found, the function does nothing and returns `NULL`
+#'
+#' ## Compatibility:
+#' The resulting R script is compatible with Quarto's script rendering via
+#' `knitr::spin()` and can be rendered directly with `quarto render script.R`.
+#' See <https://quarto.org/docs/computations/render-scripts.html#knitr> for
+#' more details on rendering R scripts with Quarto.
+#'
+#' The resulting R script uses Quarto's executable cell format with `#|`
+#' comments to preserve chunk options like `echo`, `eval`, `output`, etc.
+#'
+#' @return Invisibly returns the path to the created R script file, or
+#'   `NULL` if no R code cells were found.
+#'
+#' @examples
+#' \dontrun{
+#' # Convert a Quarto document to R script
+#' qmd_to_r_script("my-document.qmd")
+#' # Creates "my-document.R"
+#'
+#' # Specify custom output file
+#' qmd_to_r_script("my-document.qmd", script = "extracted-code.R")
+#' }
+#'
+#' @export
+qmd_to_r_script <- function(qmd, script = NULL) {
+  if (!file.exists(qmd)) {
+    cli::cli_abort(
+      c(
+        "File {.file {qmd}} does not exist.",
+        ">" = "Please provide a valid Quarto document."
+      ),
+      call = rlang::caller_env()
+    )
+  }
+
+  if (is.null(script)) {
+    script <- fs::path_ext_set(qmd, "R")
+  }
+
+  if (file.exists(script)) {
+    cli::cli_abort(
+      c(
+        "File {.file {script}} already exists.",
+        ">" = "Please provide a new file name or remove the existing file."
+      )
+    )
+  }
+
+  inspect <- quarto::quarto_inspect(qmd)
+  fileInformation <- inspect$fileInformation[[1]]
+
+  codeCells <- fileInformation$codeCells
+  if (length(codeCells) == 0) {
+    cli::cli_inform(
+      c(
+        "No code cells found in {.file {qmd}}.",
+        ">" = "This function only extracts R code cells."
+      )
+    )
+    return(invisible(NULL))
+  }
+  if (all(codeCells$language != "r")) {
+    cli::cli_inform(
+      c(
+        "No R code cells found in {.file {qmd}}, only: {.emph {paste(unique(codeCells$language))}}.",
+        ">" = "This function only extracts R code cells."
+      ),
+      call = rlang::caller_env()
+    )
+    return(invisible(NULL))
+  }
+
+  if (any(codeCells$language != "r")) {
+    cli::cli_inform(
+      c(
+        "Extracting only R code cells from {.file {qmd}}.",
+        ">" = "Other languages will be ignored (found {.emph {paste(setdiff(unique(codeCells$language), 'r'))}})."
+      ),
+      call = rlang::caller_env()
+    )
+  }
+
+  r_codeCells <- codeCells[codeCells$language == "r", ]
+
+  content <- character(nrow(r_codeCells))
+  for (i in seq_len(nrow(r_codeCells))) {
+    row <- r_codeCells[i, ]
+    metadata_list <- as.list(row$metadata)
+    metadata_clean <- metadata_list[!is.na(metadata_list)]
+    content[i] <- paste(
+      c(create_code_preamble(metadata_clean), row$source),
+      collapse = "\n"
+    )
+  }
+
+  xfun::write_utf8(content, script)
+  add_spin_preamble(script, preamble = fileInformation$metadata, quiet = TRUE)
+}

_pkgdown.yml

@@ -69,3 +69,4 @@ reference:
   contents:
   - write_yaml_metadata_block
   - add_spin_preamble
+  - qmd_to_r_script

man/add_spin_preamble.Rd

@@ -0,0 +1,26 @@
+# qmd_to_r_script() errors on wrong qmd
+
+    Code
+      qmd_to_r_script("nonexistent.qmd")
+    Condition
+      Error:
+      ! File 'nonexistent.qmd' does not exist.
+      > Please provide a valid Quarto document.
+
+# qmd_to_r_script() errors on existing script
+
+    Code
+      qmd_to_r_script(resources_path("purl-r.qmd"), script = r_script)
+    Condition
+      Error in `qmd_to_r_script()`:
+      ! File <r script> already exists.
+      > Please provide a new file name or remove the existing file.
+
+# qmd_to_r_script() ignore other language code
+
+    Code
+      qmd_to_r_script(resources_path("purl-r-ojs.qmd"), r_script)
+    Message
+      Extracting only R code cells from 'resources/purl-r-ojs.qmd'.
+      > Other languages will be ignored (found ojs).
+

man/qmd_to_r_script.Rd

@@ -0,0 +1,13 @@
+#' ---
+#' title: Purl Test Document
+#' format: html
+#' ---
+#' 
+
+#| echo: false
+#| output: asis
+cat("Hello, world")
+
+#| echo: true
+cat("more")
+