quarto: more flexible discovery (#1055)

* script.R with _quarto.yml is identified as quarto-static.
* script.R without _quarto.yml is identified as quarto-static assuming it is
  not identified as some other content type.
* script.R can be identified as the primary quarto-static document.
* bundling only renames the primary script.R for shiny content.

R/appDependencies.R

@@ -123,7 +123,11 @@ appDependencies <- function(appDir = getwd(),
     ))
   }
 
-  bundleDir <- bundleAppDir(appDir, appFiles)
+  bundleDir <- bundleAppDir(
+    appDir = appDir,
+    appFiles = appFiles,
+    appMode = appMetadata$appMode
+  )
   defer(unlink(bundleDir, recursive = TRUE))
 
   extraPackages <- inferRPackageDependencies(appMetadata)

R/appMetadata.R

@@ -29,7 +29,10 @@ appMetadata <- function(appDir,
 
   if (is.null(appMode)) {
     # Generally we want to infer appPrimaryDoc from appMode, but there's one
-    # special case
+    # special case: RStudio provides appPrimaryDoc when deploying Shiny
+    # applications. They may have name.R, not app.R or server.R.
+    #
+    # This file is later renamed to app.R when deployed by bundleAppDir().
     if (!is.null(appPrimaryDoc) &&
           tolower(tools::file_ext(appPrimaryDoc)) == "r") {
       appMode <- "shiny"
@@ -118,15 +121,27 @@ inferAppMode <- function(absoluteRootFiles,
   }
 
   rmdFiles <- matchingNames(absoluteRootFiles, "\\.rmd$")
+  hasRmd <- length(rmdFiles) > 0
   qmdFiles <- matchingNames(absoluteRootFiles, "\\.qmd$")
+  hasQmd <- length(qmdFiles) > 0
+  rFiles <- matchingNames(absoluteRootFiles, "\\.r$")
+  hasR <- length(rFiles) > 0
+  quartoYml <- matchingNames(absoluteRootFiles, "^_quarto.y(a)?ml$")
+  hasQuartoYml <- length(quartoYml) > 0
 
   if (is.na(usesQuarto)) {
-    # Can't use _quarto.yml alone because it causes deployment failures for
-    # static content: https://github.com/rstudio/rstudio/issues/11444
-    quartoYml <- matchingNames(absoluteRootFiles, "^_quarto.y(a)?ml$")
-
-    usesQuarto <- length(qmdFiles) > 0 ||
-      (length(quartoYml) > 0 && length(rmdFiles > 0))
+    # Determine if the incoming content implies the need for Quarto.
+    #
+    # *.qmd files are enough of an indication by themselves.
+    # *.rmd and *.r files need a _quarto.yml file to emphasize the need for Quarto.
+    #
+    # Do not rely on _quarto.yml alone, as RStudio includes that file even when
+    # publishing HTML. https://github.com/rstudio/rstudio/issues/11444
+    usesQuarto <- (
+      hasQmd ||
+      (hasQuartoYml && hasRmd) ||
+      (hasQuartoYml && hasR)
+    )
   }
 
   # Documents with "server: shiny" in their YAML front matter need shiny too
@@ -144,8 +159,8 @@ inferAppMode <- function(absoluteRootFiles,
   }
 
   # Shiny application using server.R; checked later than Rmd with shiny runtime
-  # because server.R may contain the server code paired with a ShinyRmd and needs
-  # to be run by rmarkdown::run (rmd-shiny).
+  # because server.R may contain the server code paired with a ShinyRmd and
+  # needs to be run by rmarkdown::run (rmd-shiny).
   serverR <- matchingNames(absoluteRootFiles, "^server.r$")
   if (length(serverR) > 0) {
     return("shiny")
@@ -166,6 +181,15 @@ inferAppMode <- function(absoluteRootFiles,
     }
   }
 
+  if (hasR) {
+    # We have R scripts but it was not otherwise identified as Shiny or Plumber
+    # and also not accompanied by *.qmd or *.rmd files.
+    #
+    # Assume that this is a rendered script, as this is a better fall-back than
+    # "static".
+    return("quarto-static")
+  }
+
   # no renderable content
   "static"
 }
@@ -227,7 +251,11 @@ inferAppPrimaryDoc <- function(appPrimaryDoc, appFiles, appMode) {
   }
 
   # determine expected primary document extension
-  ext <- if (appMode == "static") "\\.html?$" else "\\.[Rq]md$"
+  ext <- switch(appMode,
+                "static"        = "\\.html?$",
+                "quarto-static" = "\\.(r|rmd|qmd)",
+                "quarto-shiny"  = "\\.(rmd|qmd)",
+                "\\.rmd$")
 
   # use index file if it exists
   matching <- grepl(paste0("^index", ext), appFiles, ignore.case = TRUE)
@@ -237,7 +265,7 @@ inferAppPrimaryDoc <- function(appPrimaryDoc, appFiles, appMode) {
 
     if (!any(matching)) {
       cli::cli_abort(c(
-        "Failed to determine {.arg appPrimaryDoc}.",
+        "Failed to determine {.arg appPrimaryDoc} for {.str {appMode}} content.",
         x = "No files matching {.str {ext}}."
       ))
     }

R/bundle.R

@@ -3,27 +3,38 @@
 # in this process, including renaming single-file Shiny apps to "app.R" and
 # stripping packrat and renv commands from .Rprofile. Returns the path to the
 # temporary directory.
-bundleAppDir <- function(appDir, appFiles, appPrimaryDoc = NULL, verbose = FALSE) {
-
+bundleAppDir <- function(
+  appDir,
+  appFiles,
+  appPrimaryDoc = NULL,
+  appMode = NULL,
+  verbose = FALSE
+) {
   logger <- verboseLogger(verbose)
-  logger("Creating tempfile for appdir")
-  # create a directory to stage the application bundle in
+
+  logger("Creating bundle staging directory")
   bundleDir <- dirCreate(tempfile())
   defer(unlink(bundleDir))
 
-  logger("Copying files")
-  # copy the files into the bundle dir
+  logger("Copying files into bundle staging directory")
   for (file in appFiles) {
     logger("Copying", file)
     from <- file.path(appDir, file)
     to <- file.path(bundleDir, file)
-    # if deploying a single-file Shiny application, name it "app.R" so it can
-    # be run as an ordinary Shiny application
-    if (is.character(appPrimaryDoc) &&
-        tolower(tools::file_ext(appPrimaryDoc)) == "r" &&
-        file == appPrimaryDoc) {
-      to <- file.path(bundleDir, "app.R")
+
+    if (!is.null(appMode) && appMode == "shiny") {
+      # When deploying a single-file Shiny application and we have been provided
+      # appPrimaryDoc (usually by RStudio), rename that file to `app.R` so it
+      # will be discovered and run by shiny::runApp(getwd()).
+      #
+      # Note: We do not expect to see writeManifest(appPrimaryDoc="notapp.R").
+      if (is.character(appPrimaryDoc) &&
+            tolower(tools::file_ext(appPrimaryDoc)) == "r" &&
+            file == appPrimaryDoc) {
+        to <- file.path(bundleDir, "app.R")
+      }
     }
+
     dirCreate(dirname(to))
     file.copy(from, to, copy.date = TRUE)
 

R/deployApp.R

@@ -637,7 +637,9 @@ bundleApp <- function(appName,
   bundleDir <- bundleAppDir(
       appDir = appDir,
       appFiles = appFiles,
-      appPrimaryDoc = appMetadata$appPrimaryDoc)
+      appPrimaryDoc = appMetadata$appPrimaryDoc,
+      appMode = appMetadata$appMode
+  )
   defer(unlink(bundleDir, recursive = TRUE))
 
   # generate the manifest and write it into the bundle dir

R/writeManifest.R

@@ -50,7 +50,8 @@ writeManifest <- function(appDir = getwd(),
   bundleDir <- bundleAppDir(
     appDir = appDir,
     appFiles = appFiles,
-    appPrimaryDoc = appMetadata$appPrimaryDoc
+    appPrimaryDoc = appMetadata$appPrimaryDoc,
+    appMode = appMetadata$appMode
   )
   defer(unlink(bundleDir, recursive = TRUE))
 

tests/testthat/_snaps/appMetadata.md

@@ -29,12 +29,30 @@
       inferAppPrimaryDoc(NULL, "a.R", "static")
     Condition
       Error in `inferAppPrimaryDoc()`:
-      ! Failed to determine `appPrimaryDoc`.
+      ! Failed to determine `appPrimaryDoc` for "static" content.
       x No files matching "\\.html?$".
     Code
-      inferAppPrimaryDoc(NULL, "a.R", "rmd-shiny")
+      inferAppPrimaryDoc(NULL, "a.html", "rmd-static")
     Condition
       Error in `inferAppPrimaryDoc()`:
-      ! Failed to determine `appPrimaryDoc`.
-      x No files matching "\\.[Rq]md$".
+      ! Failed to determine `appPrimaryDoc` for "rmd-static" content.
+      x No files matching "\\.rmd$".
+    Code
+      inferAppPrimaryDoc(NULL, "a.html", "rmd-shiny")
+    Condition
+      Error in `inferAppPrimaryDoc()`:
+      ! Failed to determine `appPrimaryDoc` for "rmd-shiny" content.
+      x No files matching "\\.rmd$".
+    Code
+      inferAppPrimaryDoc(NULL, "a.html", "quarto-static")
+    Condition
+      Error in `inferAppPrimaryDoc()`:
+      ! Failed to determine `appPrimaryDoc` for "quarto-static" content.
+      x No files matching "\\.(r|rmd|qmd)".
+    Code
+      inferAppPrimaryDoc(NULL, "a.html", "quarto-shiny")
+    Condition
+      Error in `inferAppPrimaryDoc()`:
+      ! Failed to determine `appPrimaryDoc` for "quarto-shiny" content.
+      x No files matching "\\.(rmd|qmd)".
 

tests/testthat/test-appMetadata.R

@@ -116,16 +116,47 @@ test_that("can infer mode for shiny apps", {
   expect_equal(inferAppMode("server.R"), "shiny")
 })
 
-test_that("can infer mode for static quarto and rmd docs", {
+test_that("can infer mode for static rmd", {
   dir <- local_temp_app(list("foo.Rmd" = ""))
   paths <- list.files(dir, full.names = TRUE)
-
   expect_equal(inferAppMode(paths), "rmd-static")
+})
+
+test_that("can infer mode for rmd as static quarto with guidance", {
+  dir <- local_temp_app(list("foo.Rmd" = ""))
+  paths <- list.files(dir, full.names = TRUE)
   expect_equal(inferAppMode(paths, usesQuarto = TRUE), "quarto-static")
+})
+
+test_that("can infer mode for rmd as shiny quarto with guidance", {
   # Static R Markdown treated as rmd-shiny for shinyapps targets
+  dir <- local_temp_app(list("foo.Rmd" = ""))
+  paths <- list.files(dir, full.names = TRUE)
   expect_equal(inferAppMode(paths, isShinyappsServer = TRUE), "rmd-shiny")
 })
 
+test_that("can infer mode for static quarto", {
+  dir <- local_temp_app(list("foo.qmd" = ""))
+  paths <- list.files(dir, full.names = TRUE)
+  expect_equal(inferAppMode(paths), "quarto-static")
+
+  dir <- local_temp_app(list("_quarto.yml" = "", "foo.qmd" = ""))
+  paths <- list.files(dir, full.names = TRUE)
+  expect_equal(inferAppMode(paths), "quarto-static")
+
+  dir <- local_temp_app(list("_quarto.yml" = "", "foo.rmd" = ""))
+  paths <- list.files(dir, full.names = TRUE)
+  expect_equal(inferAppMode(paths), "quarto-static")
+
+  dir <- local_temp_app(list("_quarto.yml" = "", "foo.r" = ""))
+  paths <- list.files(dir, full.names = TRUE)
+  expect_equal(inferAppMode(paths), "quarto-static")
+
+  dir <- local_temp_app(list("foo.r" = ""))
+  paths <- list.files(dir, full.names = TRUE)
+  expect_equal(inferAppMode(paths), "quarto-static")
+})
+
 test_that("can infer mode for shiny rmd docs", {
   yaml_runtime <- function(runtime) {
     c("---", paste0("runtime: ", runtime), "---")
@@ -218,7 +249,10 @@ test_that("otherwise fails back to first file with matching extensions", {
 test_that("errors if no files with needed extension", {
   expect_snapshot(error = TRUE, {
     inferAppPrimaryDoc(NULL, "a.R", "static")
-    inferAppPrimaryDoc(NULL, "a.R", "rmd-shiny")
+    inferAppPrimaryDoc(NULL, "a.html", "rmd-static")
+    inferAppPrimaryDoc(NULL, "a.html", "rmd-shiny")
+    inferAppPrimaryDoc(NULL, "a.html", "quarto-static")
+    inferAppPrimaryDoc(NULL, "a.html", "quarto-shiny")
   })
 })