File: deploySite.R

package info (click to toggle)
r-cran-rsconnect 1.3.4-1
  • links: PTS, VCS
  • area: main
  • in suites: forky, sid, trixie
  • size: 2,044 kB
  • sloc: python: 185; sh: 13; makefile: 5
file content (151 lines) | stat: -rw-r--r-- 4,708 bytes parent folder | download
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
#' 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)
}