R/deploySite.R

In rsconnect: Deploy Docs, Apps, and APIs to 'Posit Connect', 'shinyapps.io', and 'RPubs'

#' Deploy a website
#'
#' Deploy an R Markdown or quarto website to a server.
#'
#' @inheritParams deployApp
#' @param siteDir Directory containing website. Defaults to current directory.
#' @param siteName Name for the site (names must be unique within
#'   an account). Defaults to the base name of the specified `siteDir`
#'   or to the name provided by a custom site generation function.
#' @param siteTitle Title for the site. For quarto sites only, if not
#'   supplied uses the title recorded in `_quarto.yml`.
#' @param render Rendering behavior for site:
#'
#'   * `"none"` uploads a static version of the current contents of
#'     the site directory.
#'   * `"local"` renders the site locally then uploads it.
#'   * `"server"` uploads the source of the site to render on the server.
#'
#'   Note that for `"none"` and `"local"` source files (e.g. `.R`, `.Rmd` and
#'   `.md`) will not be uploaded to the server.
#' @param recordDir The default, `NULL`, uses `siteDir`.
#' @param ... Additional arguments to [deployApp()]. Do not supply `appDir`
#'   or `appFiles`; these parameters are automatically generated by
#'   `deploySite()`.
#' @family Deployment functions
#' @export
deploySite <- function(siteDir = getwd(),
                       siteName = NULL,
                       siteTitle = NULL,
                       account = NULL,
                       server = NULL,
                       render = c("none", "local", "server"),
                       launch.browser = getOption("rsconnect.launch.browser", interactive()),
                       logLevel = c("normal", "quiet", "verbose"),
                       lint = FALSE,
                       metadata = list(),
                       python = NULL,
                       recordDir = NULL,
                       ...) {

  check_directory(siteDir)
  isQuarto <- file.exists(file.path(siteDir, "_quarto.yml")) ||
    file.exists(file.path(siteDir, "_quarto.yaml"))

  quiet <- identical(match.arg(logLevel), "quiet")
  if (isQuarto) {
    site <- quartoSite(siteDir, quiet = quiet)
  } else {
    site <- rmarkdownSite(siteDir, quiet = quiet)
  }

  # render locally if requested
  render <- arg_match(render)
  if (render == "local") {
    site$render()
  }

  # determine appDir based on whether we are rendering on the server
  if (render == "server") {
    appDir <- siteDir
  } else {
    appDir <- site$output_dir
  }

  # Need to override recordDir to always record in the source directory
  if (is.null(recordDir)) {
    # We're deploying an entire directory, so we don't really need to set
    # a path here, but we don't want to break existing deployments so
    # we leave the existing behaviour for RMarkdown
    if (!isQuarto)  {
      name <- if (file.exists("index.Rmd")) "index.Rmd" else "index.md"
      recordDir <- file.path(siteDir, name)
    } else {
      recordDir <- siteDir
    }
  }

  deployApp(
    appName = siteName %||% site$name,
    appTitle = siteTitle %||% site$title,
    appDir = appDir,
    recordDir = recordDir,
    contentCategory = "site",
    account = account,
    server = server,
    launch.browser = launch.browser,
    logLevel = logLevel,
    lint = lint,
    metadata = metadata,
    python = python,
    ...
  )
}

quartoSite <- function(path, quiet = FALSE, error_call = caller_env()) {
  check_installed(
    "quarto",
    reason = "to deploy quarto sites",
    call = error_call
  )

  config <- quarto::quarto_inspect(path)$config

  list(
    render = function() quarto::quarto_render(path, quiet = quiet, as_job = FALSE),
    name = basename(normalizePath(path)),
    title = config$website$title %||% config$book$title %||% config$title,
    # non-site projects build in current directory
    output_dir = outputDir(path, config$project$`output-dir` %||% ".")
  )
}

rmarkdownSite <- function(siteDir, quiet = FALSE, error_call = caller_env()) {
  check_installed(
    "rmarkdown",
    version = "0.9.5.3",
    reason = "to deploy RMarkdown sites",
    call = error_call
  )

  # discover the site generator
  siteGenerator <- rmarkdown::site_generator(siteDir)
  if (is.null(siteGenerator)) {
    cli::cli_abort(
      "No `_site.yml` found in {.path {siteDir}.}",
      call = error_call
    )
  }

  list(
    render = function() {
      siteGenerator$render(
        input_file = NULL,
        output_format = NULL,
        envir = new.env(),
        quiet = quiet,
        encoding = getOption("encoding")
      )
    },
    name = siteGenerator$name,
    title = NULL,
    output_dir = outputDir(siteDir, siteGenerator$output_dir)
  )
}

outputDir <- function(wd, path) {
  old <- setwd(wd)
  defer(setwd(old))

  normalizePath(dirCreate(path), mustWork = FALSE)
}