R/plugin-html.R

In tjpalanca/webtools: Web Server Tools

#' @title HTML Application
#'
#' @description
#' This application's primary purpose is to serve HTML to its users as a
#' front-end application.
#'
#' @param lang (str) string indicating the language. defaults to `en`
#'
#' @export
HTMLPlugin <- R6Class(
  classname = "HTMLPlugin",
  inherit = Plugin,
  public = list(

    #' @description Create a new `HTMLApp`
    #' @param html       (pth) filesystem directory HTML will be rendered
    #' @param libs       (pth) path relative to the `html` for dependencies
    #' @param ...        (arg) arguments passed to [`App`] superclass
    #' @param autoreload (flg) for development, refreshes the page when
    #'                         the server reinstantiates itself
    #' @param interval   (int) seconds between interval checks
    initialize = function(
      html = pkg_user("html"),
      libs = "assets",
      lang = "en",
      autoreload = getOption("webtools.autoreload", FALSE),
      interval   = getOption("webtools.autoreload.interval", 1L)
    ) {

      assert_string(html)
      assert_string(libs)
      assert_string(lang)
      assert_flag(autoreload)

      super$initialize("html")

      dir_create(html)
      dir_create(path(html, libs))

      self$set_config(
        "html",
        html = html,
        libs = libs,
        lang = lang,
        libs_path = path(html, libs)
      )

      if (autoreload) {
        self$set_config(
          "html",
          extra_deps = autoreload_assets(interval, self$config$html$libs),
          autoreload = TRUE
        )
      }

    },

    #' @description Attach an `HTMLCapability`
    #' @param app        (App) app isntance to attach capability to
    on_attach = function(app) {

      assert_class(app, "App")

      super$on_attach(app)

      self$app$static(
        path = self$config$html$libs,
        file = self$config$html$libs_path
      )

      self$app$handle_lifecycle("end", "html_cleanup", function(server, ...) {

        # Delete the HTML folder
        html <- self$config$html
        if (dir_exists(html$html)) dir_delete(html$html)

        # Record that no existing files are served
        self$set_config("html", deps = NULL)

      })

    },

    #' @description HTML route for `{htmltools}` tags
    #'
    #' Then handler function must return objects of class `shiny.tag.list` or
    #' `shiny.tag`. At the end of the process, the HTML tags are rendered
    #' and static CSS/JS assets placed in the root `/assets` path.
    #'
    #' Some special configuration:
    #' * Add dependencies to `self$config$html$extra_deps` if you want to
    #'   add things without worrying about handler order. It will be added to
    #'   the tags at the last step
    #'
    #' @param path     (str) endpoint
    #' @param handler  (fun) handler; must have arguments
    #'                       `request`, `response`, `keys`, `...` and
    #'                       set the body to html tags
    #' @param fragment (flg) whether to return a full page or fragment
    #' @param ...      (arg) passed to `super$router()`
    router = function(path, handler, ...,
                      lang = NULL,
                      fragment = FALSE) {

      assert_string(lang, null.ok = TRUE)
      assert_flag(fragment)
      assert_route_handler(handler)

      self$app$router(
        path = path,
        handler = function(request, response, keys, ...) {

          # Execute handler function
          continue <- handler(request, response, keys, ...)
          assert_tags(response$body)

          # Add extra dependencies
          response$body <- tagList(response$body, self$config$html$extra_deps)

          # Format the output
          response$format(html = function(tags) {
            private$format_html(tags, lang = lang, fragment = fragment)
          })

          # Continue
          return(continue)

        },
        ...
      )

    }

  ),

  private = list(

    # Function implements `html_render` while remembering if it
    # has already shipped certain CSS/JS dependencies into the assets path.
    format_html = function(tags, lang, fragment) {

      html <- html_render(
        tags     = tags,
        libs     = self$config$html$libs_path,
        lang     = lang %||% self$config$html$lang,
        existing = self$config$html$deps,
        fragment = fragment
      )
      deps <- union(self$config$html$deps, attr(html, "deps"))
      self$set_config("html", deps = deps)
      return(html)

    }

  )
)

#' @describeIn HTMLPlugin Autoreload assets
#' @param interval (int) number of seconds between checks
#' @param libs     (pth) path to libs folder
#' @export
autoreload_assets <- function(interval = 1L, libs = "assets") {

  assert_int(interval)
  assert_string(libs)
  version <- pkg_vers()

  tagList(
    html_dependency(
      name    = "autoreload",
      version = version,
      src     = "js/autoreload",
      script  = list(src = "autoreload.js", type = "module"),
      package = "webtools",
      all_files = FALSE
    ),
    html_script(
      type      = "module",
      file      = pkg_inst("js/autoreload/main.js"),
      interval  = interval * 1000L,
      libs      = libs,
      version   = version,
      in_head   = TRUE,
      singleton = TRUE
    )
  )

}