R/dev-html.R

In tjpalanca/webtools: Web Server Tools

#' @title Develop an HTML page
#'
#' @description
#' Use this server when developing simple static content. Whenever you change
#' files in the `src_dir`, it will reload the package and then reload the page
#' where you are viewing it.
#'
#' Use `dev_html_stop()` to stop the monitoring.
#'
#' @param srv_fun (fun) function that generates HTML
#' @param pkg_dir (dir) directory of the package that will be loaded and
#'                      whose R and inst folders will be monitored
#' @param srv_dir (dir) place where the files will be stored and served
#' @param host    (str) IP address of the server
#' @param port    (int) port number at which to serve
#' @param daemon  (flg) run a daemonized (background) server?
#' @param verbose (flg) whether the `servr` method needs to be verbose
#' @param libs    (pth) path where libraries will be served
#' @param lang    (str) language of the HTML document
#' @param append  (tag) extra tags to add to the HTML
#' @param browser (flg) whether or not to open a browsers
#' @param exclude (chr) dependencies that will not be skipped even if existing
#'
#' @export
dev_html <- function(srv_fun,
                     pkg_dir = ".",
                     srv_dir = pkg_user("serve"),
                     libs    = "libs",
                     lang    = "en",
                     host    = "0.0.0.0",
                     port    = 3838L,
                     daemon  = TRUE,
                     browser = interactive(),
                     verbose = TRUE,
                     append  = tagList(),
                     exclude = NULL) {

  # This function can only be run in interactive settings
  assert_true(interactive())

  # Assertions
  assert_function(srv_fun)
  assert_string(host)
  assert_int(port)
  assert_flag(daemon)
  assert_flag(browser)
  assert_flag(verbose)
  assert_tags(append)
  assert_character(exclude, null.ok = TRUE)

  # Prepare the environment
  stop_all()
  pkg_dir <- path_abs(pkg_dir)
  options(webtools.dev_html.pkg_dir = pkg_dir)
  code_copy <- path(pkg_dir, "R", "inst")
  inst_copy <- path(pkg_dir, "inst", "inst")
  if (dir_exists(code_copy)) system(paste("rm", code_copy))
  if (dir_exists(inst_copy)) system(paste("rm", inst_copy))
  srv_fun <- deparse(substitute(srv_fun))
  srv_dir <- dir_create(srv_dir)
  package <- pkg_name(pkg_dir)

  # Create symbolic link for inst folder
  link_dir <- path(pkg_dir, "R", "inst")
  inst_dir <- path(pkg_dir, "inst")
  system(paste("ln -s", inst_dir, link_dir))

  # Handler serves to update the files whenever it changes
  handler <- function(...) {
    load_all(pkg_dir, helpers = FALSE, attach_testthat = FALSE)
    try({
      html <- html_render(
        tags = tagList(get(srv_fun, envir = pkg_env(package))(), append),
        libs = path(srv_dir, libs),
        lang = lang,
        existing = setdiff(getOption("webtools.dev_html.deps"), exclude)
      )
      options(webtools.dev_html.deps = setdiff(attr(html, "deps"), exclude))
      writeLines(html, path(srv_dir, "index.html"))
    })
  }
  handler()

  # Start the server
  httw(
    dir     = srv_dir,
    watch   = path(pkg_dir, "R"),
    handler = handler,
    host    = host,
    port    = port,
    daemon  = daemon,
    browser = browser,
    verbose = verbose
  )

}

#' @describeIn dev_html Stops the server
#' @param which (int) daemon numbers to stop
#' @export
dev_html_stop <- function(which = daemon_list()) {

  pkg_dir <- getOption("webtools.dev_html.pkg_dir")
  code_copy <- path(pkg_dir, "R", "inst")
  inst_copy <- path(pkg_dir, "inst", "inst")
  if (dir_exists(code_copy)) system(paste("rm", code_copy))
  if (dir_exists(inst_copy)) system(paste("rm", inst_copy))
  daemon_stop(which = which)

}

# Demo app for manual testing purposes
dev_html_demo <- function() {
  div(
    tags$h1("Hello World!"),
    tags$p("This is a demo application for testing purposes.")
  )
}