Add quarto_use_binder()

R/use.R

@@ -23,7 +23,7 @@ quarto_use_template <- function(template, no_prompt = FALSE) {
 
   quarto_bin <- find_quarto()
 
-    # This will ask for approval or stop installation
+  # This will ask for approval or stop installation
   check_extension_approval(no_prompt, "Quarto templates", "https://quarto.org/docs/extensions/formats.html#distributing-formats")
 
   args <- c("template", template, "--no-prompt")
@@ -33,6 +33,42 @@ quarto_use_template <- function(template, no_prompt = FALSE) {
   invisible()
 }
 
+quarto_use_binder <- function(no_prompt = FALSE) {
+  if (quarto_version() < "1.5") {
+    cli::cli_abort(c(
+      "Binder feature for Quarto requires 1.5. See {.url https://quarto.org/docs/projects/binder.html}.",
+      i = "You are using {.strong {quarto_version()}} from {.file {quarto_path()}}.")
+    )
+  }
+
+  if (!no_prompt) {
+    if (!rlang::is_interactive()) {
+      cli::cli_abort(c(
+        "{.code quarto use binder} requires explicit approval as it will write some configurations files to your project.",
+        '>' = "Set {.arg no_prompt = TRUE} if you agree.",
+         i  = "See more at {.url https://quarto.org/docs/projects/binder.html}")
+      )
+    } else {
+      cli::cli_inform(c(
+        "{.code quarto use binder} will write some configurations files to your project.",
+        '*' = "If you are not sure what it will do, we recommend consulting documentation at {.url https://quarto.org/docs/projects/binder.html}"
+      ))
+      prompt_value <- tolower(readline("Do you want to continue ?(Y/n)? "))
+      if (!prompt_value %in% "y") {
+        cli::cli_inform("Aborting")
+        return(invisible(FALSE))
+      }
+    }
+  }
+
+  quarto_bin <- find_quarto()
+
+  args <- c("binder", "--no-prompt")
+
+  quarto_use(args, quarto_bin = quarto_bin, echo = TRUE)
+
+}
+
 quarto_use <- function(args = character(), ...) {
   quarto_run_what("use", args = args, ...)
 }

tests/testthat/_snaps/quarto-before-1.5/use.md

@@ -0,0 +1,9 @@
+# quarto_use_binder errors < 1.5
+
+    Code
+      quarto_use_binder()
+    Condition
+      Error in `quarto_use_binder()`:
+      ! Binder feature for Quarto requires 1.5. See <https://quarto.org/docs/projects/binder.html>.
+      i You are using 1.4.549 from '<quarto full path>'.
+

tests/testthat/_snaps/use.md

@@ -0,0 +1,10 @@
+# quarto_use_binder works
+
+    Code
+      quarto_use_binder(no_prompt = FALSE)
+    Condition
+      Error in `quarto_use_binder()`:
+      ! `quarto use binder` requires explicit approval as it will write some configurations files to your project.
+      > Set `no_prompt = TRUE` if you agree.
+      i See more at <https://quarto.org/docs/projects/binder.html>
+

tests/testthat/helper.R

@@ -1,9 +1,22 @@
-skip_if_no_quarto <- function() {
-  skip_if(is.null(quarto_path()))
+# Use to test quarto availability or version lower than
+skip_if_no_quarto <- function(ver = NULL) {
+  skip_if(is.null(quarto_path()), message = "Quarto is not available")
+  skip_if(
+    quarto_version() < ver,
+    message = sprintf("Version of quarto is lower than %s.", ver)
+  )
 }
 
-skip_if_quarto <- function() {
-  skip_if(!is.null(quarto_path()))
+# Use to test quarto  greater than
+skip_if_quarto <- function(ver = NULL) {
+  if (is.null(ver)) {
+    skip_if(!is.null(quarto_path()), message = "Quarto is available")
+  } else {
+    skip_if(
+      quarto_version() >= ver,
+      message = sprintf("Version of quarto is greater than or equal %s.", ver)
+    )
+  }
 }
 
 local_qmd_file <- function(..., .env = parent.frame()) {
@@ -17,6 +30,17 @@ local_qmd_file <- function(..., .env = parent.frame()) {
   path
 }
 
+local_quarto_project <- function(..., yml = list(project = list(type = "default")), .env = parent.frame()) {
+  skip_if_not_installed("withr")
+  skip_if_not_installed("yaml")
+  # Create a directory and a .qmd file
+  path <- local_qmd_file(..., .env = .env)
+  withr::local_dir(project <- dirname(path))
+  write_yaml(yml, "_quarto.yml")
+  # return the project dir
+  project
+}
+
 .render <- function(input, output_file = NULL, ..., .env = parent.frame()) {
   skip_if_no_quarto()
   skip_if_not_installed("withr")
@@ -57,7 +81,15 @@ expect_snapshot_qmd_output <- function(name, input, output_file = NULL, ...) {
 }
 
 
-transform_quarto_cli_in_output <- function(lines) {
-  # it will be quarto.exe only on windows
-  gsub("quarto.exe", "quarto", lines)
+transform_quarto_cli_in_output <- function(full_path = FALSE) {
+  return(
+    function(lines) {
+      if (full_path) {
+        gsub(find_quarto(), "<quarto full path>", lines, fixed = TRUE)
+      } else {
+        # it will be quarto.exe only on windows
+        gsub("quarto.exe", "quarto", lines)
+      }
+    }
+  )
 }

tests/testthat/test-quarto.R

@@ -8,6 +8,6 @@ test_that("quarto_run gives guidance in error", {
   expect_snapshot(
     error = TRUE,
     quarto_run(c("rend", "--quiet")),
-    transform = transform_quarto_cli_in_output
+    transform = transform_quarto_cli_in_output()
     )
 })

tests/testthat/test-use.R

@@ -8,3 +8,34 @@ test_that("Installing an extension", {
   expect_true(dir.exists("_extensions/quarto-journals/jss"))
   expect_length(list.files(pattern = "[.]qmd$"), 1)
 })
+
+test_that("quarto_use_binder errors < 1.5", {
+  skip_if_quarto(ver = "1.5")
+  expect_snapshot(
+    error = TRUE,
+    quarto_use_binder(),
+    transform = transform_quarto_cli_in_output(full_path = TRUE),
+    variant = "quarto-before-1.5"
+  )
+})
+
+test_that("quarto_use_binder works", {
+  skip_on_cran()
+  skip_if_no_quarto(ver = "1.5")
+
+  project <- local_quarto_project(
+    c("---",
+      "title: Histogram",
+      "---",
+      "",
+      "```{r}",
+      "hist(rnorm(100))",
+      "```")
+  )
+  withr::local_dir(project)
+  expect_snapshot(
+    error = TRUE,
+    quarto_use_binder(no_prompt = FALSE)
+  )
+  quarto_use_binder(no_prompt = TRUE)
+})