R/stimulus.R

In tjpalanca/hotwire.R: Hotwire for R

#' @title Stimulus
#'
#' @description
#' Stimulus is a JavaScript framework with modest ambitions. Unlike other
#' front-end frameworks, Stimulus is designed to enhance static or
#' server-rendered HTML—the “HTML you already have”—by connecting JavaScript
#' objects to elements on the page using simple annotations.
#'
#' [Documentation](https://stimulus.hotwired.dev/)
#'
#' @param app_version   (str) a string that indicates the version
#' @param controllers   (chr) paths to controller JS files
#'
#' @family Stimulus
#' @name stimulus
#' @export
Stimulus <- R6Class(

  classname = "Stimulus",
  inherit = Plugin,

  public = list(

    #' @description Create a new `TurboPlugin`
    initialize = function(controllers, app_version) {

      # Initialize superclass
      super$initialize("stimulus", "HTMLPlugin")

      # Set global configuration
      self$set_config(
        "stimulus",
        app_version = app_version,
        controllers = controllers
      )

    },

    #' @description Create a Stimulus enabled page
    #' @param path     (str) endpoint
    #' @param handler  (fun) handler; must have arguments
    #'                       `request`, `response`, `keys`, `...` and
    #'                       set the body to html tags
    #' @param ...      (arg) passed to `self$router_html()`
    #' @param lang     (str) language, defaults to `en`.
    #' @param stimulus (opt) include stimulus controller assets
    #'   * `FALSE`       - don't include stimulus controllers
    #'   * `TRUE`        - include default stimulus controllers
    #'   * `character()` - vector of paths to stimulus controller JS files;
    #'                     included along with defaults, include the word
    #'                     `"default"` to include the default assets
    #' @param fragment (flg) is this just a part of a document?
    router = function(path, handler, ...,
                      stimulus = TRUE,
                      lang     = NULL,
                      fragment = FALSE) {

      assert(test_flag(stimulus), test_character(stimulus))
      assert_route_handler(handler)
      stimulus <- self$assets(stimulus)

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

          continue <- handler(request, response, keys, ...)
          response$body <- tagList(response$body, stimulus)
          return(continue)

        },
        lang = lang,
        fragment = fragment,
        ...
      )

    },

    #' @description Generates Stimulus Assets
    #' @param stimulus (opt) include stimulus controller assets
    #'   * `FALSE`          - don't include stimulus controllers
    #'   * `TRUE`           - include default stimulus controllers
    #'   * `character()`    - vector of paths to stimulus controller JS files;
    #'                        included along with defaults, include the word
    #'                        `"default"` to include the default assets
    assets = function(stimulus = TRUE) {
      if (isFALSE(stimulus)) {
        NULL
      } else {
        if (isTRUE(stimulus)) {
          stimulus <- self$config$stimulus$controllers
        } else {
          if ("default" %in% stimulus) {
            stimulus <- setdiff(
              c(self$config$stimulus$controllers, stimulus),
              "default"
            )
          }
        }
        stimulus_assets(
          controllers = unique(stimulus),
          app_version = self$config$stimulus$app_version,
          libs = self$app$plugins$html$config$html$libs %||% "assets"
        )
      }
    }
  )

)