Standardize single doc deployment

R/appDependencies.R

@@ -39,7 +39,7 @@
 #' This will tell rsconnect that your app needs the hexbin package, without
 #' otherwise affecting your code.
 #'
-#' @inheritParams deployApp
+#' @inheritParams writeManifest
 #' @param appDir Directory containing application. Defaults to current working
 #'   directory.
 #' @return A data frame with columns:

R/deployApp.R

@@ -18,8 +18,9 @@
 #' control to ensure that future you and other collaborators will publish
 #' to the same location.
 #'
-#' @param appDir Directory containing application. Defaults to current working
-#'   directory.
+#' @param appDir Either a directory containing an application (e.g. a Shiny app
+#'   or plumber API) or a path to a document, like an `.html`, `.Rmd`, or
+#'   `.Qmd`.  Defaults to the working directory.
 #' @param appFiles A character vector given relative paths to the files and
 #'   directories to bundle and deploy. The default, `NULL`, will include all
 #'   files in `appDir`, apart from any listed in an `.rscignore` file.
@@ -154,7 +155,24 @@ deployApp <- function(appDir = getwd(),
 
   condaMode <- FALSE
 
-  check_directory(appDir)
+  check_string(appDir)
+  if (dirExists(appDir)) {
+    # ok
+  } else if (file.exists(appDir) && isStaticFile(appDir)) {
+    doc <- standardizeSingleDocDeployment(appDir)
+
+    appDir <- doc$appDir
+    appPrimaryDoc <- doc$appPrimaryDoc
+    if (is.null(appFiles) && is.null(appFileManifest)) {
+      appFiles <- doc$appFiles
+    }
+  } else {
+    cli::cli_abort(
+      "{.arg appDir} must be a directory or a .Rmd, .Qmd, or .html file"
+    )
+  }
+  appDir <- normalizePath(appDir)
+
   check_string(appName, allow_null = TRUE)
 
   # set up logging helpers
@@ -190,9 +208,6 @@ deployApp <- function(appDir = getwd(),
     on.exit(options(old_error), add = TRUE)
   }
 
-  # normalize appDir path
-  appDir <- normalizePath(appDir)
-
   # create the full path that we'll deploy (append document if requested)
   # TODO(HW): we use appPrimaryDoc here, but we have not inferred it yet
   # so the appPath will different deneding on whether it's explicitly
@@ -207,23 +222,6 @@ deployApp <- function(appDir = getwd(),
     }
   }
 
-  # if a specific file is named, make sure it's an Rmd or HTML, and just deploy
-  # a single document in this case (this will call back to deployApp with a list
-  # of supporting documents)
-  rmdFile <- ""
-  if (!dirExists(appDir)) {
-    if (grepl("\\.[Rq]md$", appDir, ignore.case = TRUE) ||
-        grepl("\\.html?$", appDir, ignore.case = TRUE)) {
-      return(deployDoc(appDir, appName = appName, appTitle = appTitle,
-                       account = account, server = server, upload = upload,
-                       recordDir = recordDir, launch.browser = launch.browser,
-                       logLevel = logLevel, lint = lint))
-    } else {
-      stop(appDir, " must be a directory, an R Markdown document, or an HTML ",
-           "document.")
-    }
-  }
-
   # directory for recording deployment
   if (is.null(recordDir)) {
     recordDir <- appPath

R/deployDoc.R

@@ -23,39 +23,51 @@
 #' @family Deployment functions
 #' @export
 deployDoc <- function(doc, ...) {
+  doc <- standardizeSingleDocDeployment(doc)
+  deployApp(
+    appDir = doc$appDir,
+    appPrimaryDoc = doc$appPrimaryDoc,
+    appFiles = doc$appFiles,
+    ...
+  )
+}
+
+standardizeSingleDocDeployment <- function(path,
+                                           quiet = FALSE,
+                                           error_call = caller_env(),
+                                           error_arg = caller_arg(path)) {
   check_installed(
     "rmarkdown",
     version = "0.5.2",
     reason = "to deploy individual R Markdown documents"
   )
+  check_file(path, error_call = error_call, error_arg = error_arg)
+  path <- normalizePath(path)
 
-  check_file(doc)
-
-  # get qualified doc
-  qualified_doc <- normalizePath(doc, winslash = "/")
+  withStatus <- withStatus(quiet)
 
-  # see if this doc has runtime: shiny_prerendered, if it does then
-  # appFiles will be NULL (bundle the entire directory)
-  if (isShinyRmd(doc)) {
-    app_files <- NULL
+  if (isShinyRmd(path)) {
+    # deploy entire directory
+    appFiles <- NULL
+  } else if (isStaticFile(path)) {
+    # deploy file + dependenciy
+    withStatus("Discovering document dependencies", {
+      resources <- rmarkdown::find_external_resources(path)
+    })
+    appFiles <- c(basename(path), resources$path)
   } else {
-    # default to deploying just the single file specified
-    app_files <- basename(qualified_doc)
-
-    # if this document's type supports automated resource discovery, do that now,
-    # and add the discovered files to the deployment list
-    ext <- tolower(tools::file_ext(doc))
-    if (ext %in% c("rmd", "qmd", "html", "htm")) {
-      message("Discovering document dependencies... ", appendLF = FALSE)
-      res <- rmarkdown::find_external_resources(qualified_doc)
-      message("OK")
-      app_files <- c(app_files, res$path)
-    }
+    # deploy just the file
+    appFiles <- basename(path)
   }
 
-  # deploy the document with the discovered dependencies
-  deployApp(appDir = dirname(qualified_doc),
-            appFiles = app_files,
-            appPrimaryDoc = basename(qualified_doc),
-            ...)
+  list(
+    appDir = dirname(path),
+    appPrimaryDoc = basename(path),
+    appFiles = appFiles
+  )
+}
+
+isStaticFile <- function(path) {
+  ext <- tolower(tools::file_ext(path))
+  ext %in% c("rmd", "qmd", "html", "htm")
 }

R/usage.R

@@ -57,6 +57,7 @@ showUsage <- function(appDir = getwd(), appName = NULL, account = NULL, server =
 #' Show application metrics of a currently deployed application.
 #' This function only works for ShinyApps servers.
 #'
+#' @inheritParams writeManifest
 #' @param metricSeries Metric series to query. Refer to the
 #'   [shinyapps.io documentation](<https://docs.posit.co/shinyapps.io/metrics.html#ApplicationMetrics>)
 #'   for available series.

R/writeManifest.R

@@ -4,6 +4,8 @@
 #' that directory describing the deployment requirements for that content.
 #'
 #' @inheritParams deployApp
+#' @param appDir Path to an application directory. Defaults to the
+#'   working directory.
 #' @param verbose If TRUE, prints progress messages to the console
 #' @export
 writeManifest <- function(appDir = getwd(),

tests/testthat/_snaps/deployDoc.md

@@ -0,0 +1,8 @@
+# deployDoc correctly reports bad path
+
+    Code
+      deployDoc("doesntexist.Rmd")
+    Condition
+      Error in `deployDoc()`:
+      ! `doc`, "doesntexist.Rmd", does not exist.
+

tests/testthat/test-deployDoc.R

@@ -0,0 +1,43 @@
+test_that("deployDoc correctly reports bad path", {
+  expect_snapshot(deployDoc("doesntexist.Rmd"), error = TRUE)
+})
+
+# standardizeSingleDocDeployment ------------------------------------------
+
+test_that("turns appDir into appDir + appPrimarySourceDoc", {
+  dir <- local_temp_app(list("foo.R" = ""))
+
+  doc <- standardizeSingleDocDeployment(file.path(dir, "foo.R"))
+  expect_equal(doc$appDir, normalizePath(dir))
+  expect_equal(doc$appPrimaryDoc, "foo.R")
+})
+
+test_that("shiny rmd deploys whole directory", {
+  dir <- local_temp_app(list("foo.Rmd" = c(
+    "---",
+    "runtime: shiny",
+    "---"
+  )))
+  doc <- standardizeSingleDocDeployment(file.path(dir, "foo.Rmd"))
+  expect_equal(doc$appFiles, NULL)
+})
+
+test_that("regular rmd deploys file and dependencies", {
+  dir <- local_temp_app(list(
+    "foo.Rmd" = c(
+      "---",
+      "resource_files: [foo.csv]",
+      "---"
+    ),
+    "foo.csv" = ""
+  ))
+
+  doc <- standardizeSingleDocDeployment(file.path(dir, "foo.Rmd"), quiet = TRUE)
+  expect_equal(doc$appFiles, c("foo.Rmd", "foo.csv"))
+})
+
+test_that("other types deploy that one file", {
+  dir <- local_temp_app(list("foo.R" = ""))
+  doc <- standardizeSingleDocDeployment(file.path(dir, "foo.R"))
+  expect_equal(doc$appFiles, "foo.R")
+})