R/dev-app.R

In tjpalanca/webtools: Web Server Tools

#' @title Develop an Application
#'
#' @description
#' This is a development utility that is meant to be called interactively to
#' speed up feedback cycles during the development of `App`s.
#'
#' Call `dev_app(app_fun)` to run the application. During each
#' `interval` seconds, the application watches the `watch` directory to see
#' if any source files in the package have changed. If any thing has changed,
#' the package is reloaded, the applicaiton is restarted, and all connected
#' clients are refreshed.
#'
#' In the global environment, call `dev_app_stop()` to stop the loop
#' and refreshing, and call `dev_app_browse()` to open a viewer to the
#' application. `dev_app_get()` retrieves the current application.
#'
#' @param app_fun  (fun) function to generate an app, must return an
#'                       [`App`] instance.
#' @param pkg_dir  (pth) location of the package to be loaded
#' @param interval (num) number of seconds between checks of changes
#' @param watch    (dir) director(ies) that is/are monitored for file changes
#' @param browse   (flg) whether or not to browse upon startup
#'
#' @export
dev_app <- function(app_fun,
                    interval = 1L,
                    pkg_dir  = ".",
                    watch    = c("R", "inst"),
                    browse   = FALSE) {

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

  # Argument assertions
  assert_function(app_fun)
  assert_number(interval, lower = 1L)
  assert_directory_exists(watch)
  assert_directory_exists(pkg_dir)
  assert_flag(browse)

  # Prepare the environment
  stop_all()
  pkg_dir <- path_abs(pkg_dir)
  options(
    webtools.autoreload = TRUE,
    webtools.dev_app.app = NULL,
    webtools.dev_app.watch = watch,
    webtools.dev_app.package = pkg_name(pkg_dir),
    webtools.dev_app.app_fun  = deparse(substitute(app_fun)),
    webtools.autoreload.interval = interval
  )

  # The develop loop runs constantly to check for changes to files
  develop_loop <- function() {

    curr <- getOption("webtools.dev_app.watch") %>%
      map(~list.files(., full.names = TRUE, recursive = TRUE)) %>%
      flatten_chr() %>%
      file.info() %$%
      mtime %>%
      max()

    if (is.null(getOption("webtools.dev_app.app"))) {

      message("Starting development loop. Use dev_app_stop() to cancel.")
      load_all(pkg_dir, helpers = FALSE, attach_testthat = FALSE)
      options(
        webtools.dev_app.app = get(
          getOption("webtools.dev_app.app_fun"),
          envir = pkg_env(getOption("webtools.dev_app.package"))
        )()
      )
      getOption("webtools.dev_app.app")$lifecycle_start(block = FALSE)
      options(webtools.dev_app.mtime = curr)
      getOption("webtools.dev_app.app")$log("info", "Application started")

    } else if (curr > getOption("webtools.dev_app.mtime")) {

      getOption("webtools.dev_app.app")$log(
        "info",
        "Changes detected; restarting..."
      )
      getOption("webtools.dev_app.app")$lifecycle_stop()
      try({
        load_all(pkg_dir, helpers = FALSE, attach_testthat = FALSE)
        options(
          webtools.dev_app.app = get(
            getOption("webtools.dev_app.app_fun"),
            envir = pkg_env(getOption("webtools.dev_app.package"))
          )()
        )
        getOption("webtools.dev_app.app")$lifecycle_start(block = FALSE)
        options(webtools.dev_app.mtime = curr)
        getOption("webtools.dev_app.app")$log("info", "Reloaded application")
      })

    }

    options(
      webtools.dev_app.cancel =
        later(develop_loop, delay = getOption("webtools.autoreload.interval"))
    )

  }

  # Start the development loop
  develop_loop()

  # If browse is enabled, browse
  if (browse) dev_app_browse()

  # Return NULL
  invisible(NULL)

}

#' @describeIn dev_app stop the looping
#' @export
dev_app_stop <- function() {

  getOption("webtools.dev_app.app")$lifecycle_stop()
  getOption("webtools.dev_app.cancel")()
  getOption("webtools.dev_app.app")$log("info", "Development loop canceled.")
  options(
    webtools.autoreload = FALSE,
    webtools.dev_app.app = NULL,
    webtools.dev_app.cancel = NULL
  )

}

#' @describeIn dev_app browse the app
#' @export
dev_app_browse <- function() {

  getOption("webtools.dev_app.app")$browse()

}

#' @describeIn dev_app get the application instance
#' @export
dev_app_get <- function() {

  getOption("webtools.dev_app.app")

}

dev_app_demo <- function(env) {

  app <- App$new(HTMLPlugin$new())

  app$static(
    path = "favicon.ico",
    file = pkg_inst("img/web.png")
  )

  app$html$router(
    "/", name = "homepage",
    function(request, response, keys, ...) {
      response$body <- tagList(
        tags$head(
          tags$title("HTML Application Demo")
        ),
        div(
          tags$h1("HTML Application"),
          tags$h4("This is an application serving HTML.")
        ),
        div(
          style = css(max_width = "1024px"),
          HTML(markdown_html(str_squish(paste0(
            "R has great utilities through `{htmltools}` to generate
              HTML on the server-side, most notably including features
              like singletons and head tags, CSS/JS dependency inclusion.",
            "The HTML Application is able to take tags generated using ",
            "`{htmltools}` and serve them at different `{fiery}` routers.",
            "CSS and JS dependencies can be included in the body and they
              will be served automatically as static assets in a specific
              subpath of the application, allowing more complex applications
              to be built on top of `HTMLApp`.",
            collapse = "\n"
          ))))
        )
      )
      return(FALSE)
    }
  )

  return(app)

}