feat(reactlog_widget): Add an htmlwidget for the reactlog (#160)

DESCRIPTION

@@ -23,13 +23,17 @@ Depends:
     R (>= 3.0.2)
 Imports:
     jsonlite (>= 0.9.16),
+    rlang,
     rmarkdown
 Suggests:
     fontawesome (>= 0.3.0),
     htmltools,
+    htmlwidgets,
     knitr,
     shiny (>= 1.5.0),
-    testthat
+    shinytest2,
+    testthat,
+    withr
 VignetteBuilder: 
     knitr
 Config/roxygen2/version: 8.1.1

NAMESPACE

@@ -6,4 +6,9 @@ export(reactlog_module_server)
 export(reactlog_module_ui)
 export(reactlog_render)
 export(reactlog_show)
+export(reactlog_widget)
+export(reactlog_widget_module_server)
+export(reactlog_widget_module_ui)
+export(reactlog_widget_output)
 export(reactlog_write)
+export(render_reactlog_widget)

NEWS.md

@@ -1,5 +1,7 @@
 # reactlog (development)
 
+- Added `reactlog_widget()`, which shows the reactlog as an htmlwidget so it can be embedded in R Markdown or Quarto documents. Like `reactlog_show()`, `log` defaults to `shiny::reactlog()`. To show it in a Shiny app, use `reactlog_widget_module_ui()` and `reactlog_widget_module_server()`, or `reactlog_widget_output()` and `render_reactlog_widget()`. Requires the htmlwidgets package (#160)
+
 - `reactlog_show()` now uses `shiny::reactlog()` as its default `log`, so `reactlog_show()` works with no arguments after running an app (#91)
 
 - The graph legend now shows that a solid line is a dependency, a dashed line is an `isolate()`d dependency, and a dotted line is an inactive dependency (one that existed earlier but is not active at the current step) (#76)

R/renderReactLog.R

@@ -11,31 +11,7 @@ inst_reactlog_assets <- function() {
 #' @param session_token token to be used to subset which session is displayed.
 #'   Defaults to all sessions.
 reactlog_render <- function(log, session_token = NULL, time = TRUE) {
-  log <- reactlog_upgrade(log)
-
-  template_file <- inst_reactlog_file("reactlog.html")
-  # does not need utf8 support
-  html <- paste(readLines(template_file, warn = FALSE), collapse = "\n")
-
-  # get the json form of the lgo without writing to disk
-  json_blob <- as.character(
-    reactlog_write(log, file = NULL, session_token = session_token)
-  )
-
-  fixed_sub <- function(...) {
-    sub(..., fixed = TRUE)
-  }
-
-  html <- fixed_sub(
-    "__DATA__", paste(json_blob, collapse = "\n"),
-    fixed_sub(
-      "__TIME__", paste0("\"", time, "\""),
-      fixed_sub(
-        "<script src=\"defaultLog.js\"></script>", "",
-        html
-      )
-    )
-  )
+  html <- reactlog_page_html(log, session_token = session_token, time = time)
 
   # check if shiny is even available
   if (requireNamespace("shiny", quietly = TRUE)) {
@@ -60,3 +36,32 @@ reactlog_render <- function(log, session_token = NULL, time = TRUE) {
 
   file
 }
+
+fixed_sub <- function(...) {
+  sub(..., fixed = TRUE)
+}
+
+# The reactlog page as one string. Assets are still linked from `reactlogAsset/`.
+reactlog_page_html <- function(log, session_token = NULL, time = TRUE) {
+  log <- reactlog_upgrade(log)
+
+  template_file <- inst_reactlog_file("reactlog.html")
+  # does not need utf8 support
+  html <- paste(readLines(template_file, warn = FALSE), collapse = "\n")
+
+  # get the json form of the lgo without writing to disk
+  json_blob <- as.character(
+    reactlog_write(log, file = NULL, session_token = session_token)
+  )
+
+  fixed_sub(
+    "__DATA__", paste(json_blob, collapse = "\n"),
+    fixed_sub(
+      "__TIME__", paste0("\"", time, "\""),
+      fixed_sub(
+        "<script src=\"defaultLog.js\"></script>", "",
+        html
+      )
+    )
+  )
+}

R/shinyModule.R

@@ -55,17 +55,20 @@
 reactlog_module_ui <- function(include_refresh = TRUE, id = "reactlog_module") {
   ns <- shiny::NS(id)
   shiny::tagList(
-    if (isTRUE(include_refresh))
-      shiny::actionButton(
-        ns("refresh"),
-        "",
-        icon = shiny::icon("arrows-rotate", lib = "font-awesome"),
-        class = "btn-sm btn-warning"
-      ),
+    if (isTRUE(include_refresh)) refresh_button(ns),
     shiny::uiOutput(ns("iframe"))
   )
 }
 
+refresh_button <- function(ns) {
+  shiny::actionButton(
+    ns("refresh"),
+    "",
+    icon = shiny::icon("arrows-rotate", lib = "font-awesome"),
+    class = "btn-sm btn-warning"
+  )
+}
+
 #' @rdname reactlog_module
 #' @export
 reactlog_module_server <- function(
@@ -146,3 +149,63 @@ assert_shiny_version <- function() {
     stop("`shiny` v", shiny_version_required(), " or greater must be installed")
   }
 }
+
+
+#' Reactlog widget Shiny module
+#'
+#' Displays a [reactlog_widget()] in the given application, filtered to the
+#' current session. Unlike [reactlog_module_ui()], the log is sent through
+#' Shiny's websocket, so it does not need the `reactlog` URL that Shiny serves.
+#'
+#' The log is read when the widget renders. Click the refresh button to show
+#' newer entries. The first render runs before Shiny is idle for the first
+#' time, so it may not show a complete step until refreshed.
+#'
+#' @inheritParams reactlog_module_ui
+#' @param width,height Size of the widget. Must be a valid CSS unit or a number.
+#' @seealso [reactlog_widget_output()]
+#' @rdname reactlog_widget_module
+#' @export
+#' @examples
+#' if (interactive()) {
+#'   library(shiny)
+#'   reactlog_enable()
+#'
+#'   ui <- fluidPage(
+#'     numericInput("n", "n", 1),
+#'     reactlog_widget_module_ui()
+#'   )
+#'   server <- function(input, output, session) {
+#'     reactlog_widget_module_server()
+#'   }
+#'   shinyApp(ui, server)
+#' }
+reactlog_widget_module_ui <- function(
+  include_refresh = TRUE,
+  id = "reactlog_widget_module",
+  width = "100%",
+  height = "600px"
+) {
+  ns <- shiny::NS(id)
+  shiny::tagList(
+    if (isTRUE(include_refresh)) refresh_button(ns),
+    reactlog_widget_output(ns("widget"), width = width, height = height)
+  )
+}
+
+#' @rdname reactlog_widget_module
+#' @export
+reactlog_widget_module_server <- function(id = "reactlog_widget_module") {
+  assert_shiny_version()
+
+  shiny::moduleServer(
+    id,
+    function(input, output, session) {
+      output$widget <- render_reactlog_widget({
+        # trigger render refresh
+        input$refresh
+        reactlog_widget(session_token = session$token)
+      })
+    }
+  )
+}

R/widget.R

@@ -0,0 +1,143 @@
+#' Reactlog htmlwidget
+#'
+#' Displays the reactlog as an \pkg{htmlwidgets} widget, so it can be embedded
+#' in R Markdown or Quarto documents, or shown in the RStudio viewer.
+#'
+#' The widget is a self-contained page shown in an `<iframe>`. Requires the
+#' \pkg{htmlwidgets} package.
+#'
+#' @inheritParams reactlog_show
+#' @param width,height Size of the widget. Defaults to `"100%"` wide and
+#'   `600` pixels tall.
+#' @param elementId Optional element id for the widget.
+#' @seealso [reactlog_show()]
+#' @export
+#' @examples
+#' \dontrun{
+#' library(shiny)
+#' reactlog_enable()
+#'
+#' # run a shiny app
+#' app <- system.file("examples/01_hello", package = "shiny")
+#' runApp(app)
+#'
+#' # once app has closed, display reactlog as a widget
+#' reactlog_widget()
+#' }
+reactlog_widget <- function(
+  log = shiny::reactlog(),
+  time = TRUE,
+  ...,
+  width = NULL,
+  height = NULL,
+  elementId = NULL # nolint: object_name_linter.
+) {
+  rlang::check_installed("htmlwidgets")
+
+  html <- reactlog_page_html(log, time = as.logical(time), ...)
+
+  htmlwidgets::createWidget(
+    name = "reactlog",
+    x = list(html = reactlog_inline_assets(html)),
+    width = width,
+    height = height,
+    package = "reactlog",
+    elementId = elementId,
+    sizingPolicy = htmlwidgets::sizingPolicy(
+      defaultWidth = "100%",
+      defaultHeight = 600,
+      knitr.figure = FALSE
+    )
+  )
+}
+
+#' Shiny bindings for `reactlog_widget()`
+#'
+#' Output and render functions for using [reactlog_widget()] within Shiny
+#' applications. The log is read when `expr` runs, so make `expr` depend on an
+#' input (such as a refresh button) to show newer entries.
+#'
+#' The first render runs before Shiny is idle for the first time, so it may not
+#' show a complete step. Refresh to load the full log.
+#'
+#' @param output_id Output variable to read from.
+#' @param width,height Must be a valid CSS unit (like `"100%"`, `"400px"`,
+#'   `"auto"`) or a number, which will be coerced to a string and have `"px"`
+#'   appended.
+#' @param expr An expression that returns a [reactlog_widget()].
+#' @param env The environment in which to evaluate `expr`.
+#' @param quoted Is `expr` a quoted expression (with `quote()`)?
+#' @export
+#' @examples
+#' if (interactive()) {
+#'   library(shiny)
+#'   reactlog_enable()
+#'
+#'   ui <- fluidPage(
+#'     numericInput("n", "n", 1),
+#'     actionButton("refresh", "Refresh"),
+#'     reactlog_widget_output("reactlog")
+#'   )
+#'   server <- function(input, output, session) {
+#'     output$reactlog <- render_reactlog_widget({
+#'       input$refresh
+#'       reactlog_widget(session_token = session$token)
+#'     })
+#'   }
+#'   shinyApp(ui, server)
+#' }
+reactlog_widget_output <- function(output_id, width = "100%", height = "600px") {
+  rlang::check_installed("htmlwidgets")
+  htmlwidgets::shinyWidgetOutput(output_id, "reactlog", width, height, package = "reactlog")
+}
+
+#' @rdname reactlog_widget_output
+#' @export
+render_reactlog_widget <- function(expr, env = parent.frame(), quoted = FALSE) {
+  rlang::check_installed("htmlwidgets")
+  if (!quoted) {
+    expr <- substitute(expr)
+  }
+  htmlwidgets::shinyRenderWidget(expr, reactlog_widget_output, env, quoted = TRUE)
+}
+
+# Put the css, js, and images into the page so it works from an iframe `srcdoc`
+reactlog_inline_assets <- function(html) {
+  asset_dir <- inst_reactlog_assets()
+  read_asset <- function(file) {
+    paste(readLines(file.path(asset_dir, file), warn = FALSE), collapse = "\n")
+  }
+  svg_uri <- function(file) {
+    path <- file.path(asset_dir, "images", file)
+    paste0(
+      "data:image/svg+xml;base64,",
+      # base64_enc() adds line breaks, which break css `url("...")`
+      gsub("\n", "", jsonlite::base64_enc(readBin(path, "raw", file.size(path))), fixed = TRUE)
+    )
+  }
+
+  for (css in c("fira-mono_source-sans-pro_latin-ext.css", "reactlog.css")) {
+    content <- fixed_sub(
+      "url(\"images/iconSearch.svg\")",
+      paste0("url(\"", svg_uri("iconSearch.svg"), "\")"),
+      read_asset(css)
+    )
+    html <- fixed_sub(
+      paste0("<link rel=\"stylesheet\" type=\"text/css\" href=\"reactlogAsset/", css, "\">"),
+      paste0("<style>", content, "</style>"),
+      html
+    )
+  }
+
+  html <- fixed_sub(
+    "<script src=\"reactlogAsset/reactlog.js\"></script>",
+    paste0("<script>", read_asset("reactlog.js"), "</script>"),
+    html
+  )
+
+  for (svg in dir(file.path(asset_dir, "images"))) {
+    html <- gsub(paste0("./reactlogAsset/images/", svg), svg_uri(svg), html, fixed = TRUE)
+  }
+
+  html
+}

inst/htmlwidgets/reactlog.js

@@ -0,0 +1,18 @@
+HTMLWidgets.widget({
+  name: "reactlog",
+  type: "output",
+  factory: function (el) {
+    var iframe = document.createElement("iframe");
+    iframe.style.width = "100%";
+    iframe.style.height = "100%";
+    iframe.style.border = "none";
+    el.appendChild(iframe);
+
+    return {
+      renderValue: function (x) {
+        iframe.srcdoc = x.html;
+      },
+      resize: function () {},
+    };
+  },
+});