From 71d0f6d0446232ec6f474a7b94eb585e26fb078e Mon Sep 17 00:00:00 2001 From: Aron Atkins Date: Mon, 25 Mar 2024 15:51:33 -0400 Subject: [PATCH] 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 | 6 +++- R/appMetadata.R | 50 ++++++++++++++++++++++------ R/bundle.R | 35 ++++++++++++------- R/deployApp.R | 4 ++- R/writeManifest.R | 3 +- tests/testthat/_snaps/appMetadata.md | 26 ++++++++++++--- tests/testthat/test-appMetadata.R | 40 ++++++++++++++++++++-- 7 files changed, 131 insertions(+), 33 deletions(-) diff --git a/R/appDependencies.R b/R/appDependencies.R index 492c5f8f..645a4da6 100644 --- a/R/appDependencies.R +++ b/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) diff --git a/R/appMetadata.R b/R/appMetadata.R index 105e097f..76fa5dae 100644 --- a/R/appMetadata.R +++ b/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}}." )) } diff --git a/R/bundle.R b/R/bundle.R index de415a4b..23dfc48d 100644 --- a/R/bundle.R +++ b/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) diff --git a/R/deployApp.R b/R/deployApp.R index dd10583c..d9f4b9c7 100644 --- a/R/deployApp.R +++ b/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 diff --git a/R/writeManifest.R b/R/writeManifest.R index 904ec600..fcca88a8 100644 --- a/R/writeManifest.R +++ b/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)) diff --git a/tests/testthat/_snaps/appMetadata.md b/tests/testthat/_snaps/appMetadata.md index d105f445..b096c678 100644 --- a/tests/testthat/_snaps/appMetadata.md +++ b/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)". diff --git a/tests/testthat/test-appMetadata.R b/tests/testthat/test-appMetadata.R index bd1841dc..f66fd32f 100644 --- a/tests/testthat/test-appMetadata.R +++ b/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") }) })