File: rmdshot.R

package info (click to toggle)
r-cran-webshot 0.5.5-1
  • links: PTS, VCS
  • area: main
  • in suites: sid, trixie
  • size: 600 kB
  • sloc: javascript: 5,565; makefile: 5
file content (83 lines) | stat: -rw-r--r-- 2,387 bytes parent folder | download | duplicates (4)
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
#' Take a snapshot of an R Markdown document
#'
#' This function can handle both static Rmd documents and Rmd documents with
#' \code{runtime: shiny}.
#'
#' @inheritParams appshot
#' @param doc The path to a Rmd document.
#' @param delay Time to wait before taking screenshot, in seconds. Sometimes a
#'   longer delay is needed for all assets to display properly. If NULL (the
#'   default), then it will use 0.2 seconds for static Rmd documents, and 3
#'   seconds for Rmd documents with runtime:shiny.
#' @param rmd_args A list of additional arguments to pass to either
#'   \code{\link[rmarkdown]{render}} (for static Rmd documents) or
#'   \code{\link[rmarkdown]{run}} (for Rmd documents with runtime:shiny).
#'
#' @examples
#' if (interactive()) {
#'   # rmdshot("rmarkdown_file.Rmd", "snapshot.png")
#'
#'   # R Markdown file
#'   input_file <- system.file("examples/knitr-minimal.Rmd", package = "knitr")
#'   rmdshot(input_file, "minimal_rmd.png")
#'
#'   # Shiny R Markdown file
#'   input_file <- system.file("examples/shiny.Rmd", package = "webshot")
#'   rmdshot(input_file, "shiny_rmd.png", delay = 5)
#' }
#'
#' @export
rmdshot <- function(doc, file = "webshot.png", ..., delay = NULL, rmd_args = list(),
                    port = getOption("shiny.port"), envvars = NULL) {

  runtime <- rmarkdown::yaml_front_matter(doc)$runtime

  if (is_shiny(runtime)) {
    if (is.null(delay)) delay <- 3

    rmdshot_shiny(doc, file, ..., delay = delay, rmd_args = rmd_args,
      port = port, envvars = envvars)

  } else {
    if (is.null(delay)) delay <- 0.2

    outfile <- tempfile("webshot", fileext = ".html")
    do.call(rmarkdown::render, c(list(doc, output_file = outfile), rmd_args))
    webshot(outfile, file = file, ...)
  }
}


rmdshot_shiny <- function(doc, file, ..., rmd_args, port, envvars) {

  port <- available_port(port)
  url <- shiny_url(port)

  # Run app in background with envvars
  p <- r_background_process(
    function(...) {
      rmarkdown::run(...)
    },
    args = append(
      list(file = doc, shiny_args = list(port = port)),
      rmd_args
    ),
    envvars = envvars
  )
  on.exit({
    p$kill()
  })

  # Wait for app to start
  wait_until_server_exists(url)

  fileout <- webshot(url, file = file, ...)

  invisible(fileout)
}


# Borrowed from rmarkdown
is_shiny <- function (runtime) {
  !is.null(runtime) && grepl("^shiny", runtime)
}