Add unit tests

.github/workflows/deploy.yml

@@ -14,7 +14,7 @@ jobs:
     env:
       cache-version: 5
     steps:
-      - uses: actions/checkout@v2
+      - uses: actions/checkout@v4
       - name: Set up libraries for Ubuntu
         run: |
           sudo apt-get update
@@ -36,7 +36,7 @@ jobs:
         shell: Rscript {0}
       - name: Cache dependencies
         id: cache-deps
-        uses: actions/cache@v2
+        uses: actions/cache@v4
         with:
           path: ${{ env.R_LIBS_USER }}/*
           key: ${{ hashFiles('DESCRIPTION') }}-${{ steps.get-version.outputs.os-version }}-${{ steps.get-version.outputs.r-version }}-${{ env.cache-version }}-deps
@@ -69,7 +69,7 @@ jobs:
         run: |
           Rscript -e 'devtools::document(); pkgdown::build_site(new_process = FALSE)'
           touch docs/.nojekyll
-      - uses: actions/upload-pages-artifact@v1
+      - uses: actions/upload-pages-artifact@v3
         if: ${{ github.event_name == 'push' && github.ref == 'refs/heads/main' }}
         with:
           path: ./docs
@@ -84,4 +84,4 @@ jobs:
       - name: Deploy to GitHub Pages
         id: deployment
         if: ${{ github.event_name == 'push' && github.ref == 'refs/heads/main' }}
-        uses: actions/deploy-pages@v1
+        uses: actions/deploy-pages@v4

R/widget.R

@@ -247,33 +247,46 @@ AnyHtmlWidget <- R6::R6Class("AnyHtmlWidget",
     },
     #' @description
     #' Render the widget.
-    render = function() {
+    render = function(return_widget = FALSE) {
       if(private$.mode == "static") {
-        invoke_static(self)
+        invoke_static(self, return_widget = return_widget)
       } else if(private$.mode == "gadget") {
-        invoke_gadget(self)
+        invoke_gadget(self, return_widget = return_widget)
       } else if(private$.mode == "dynamic") {
-        invoke_dynamic(self)
+        invoke_dynamic(self, return_widget = return_widget)
       } else {
         stop("render is meant for use with static, gadget, and dynamic modes")
       }
+    },
+    #' @description
+    #' Return the htmlwidget.
+    #' Only works in "static" or "dynamic" mode.
+    .get_htmlwidget = function() {
+      if(private$.mode == "static" || private$.mode == "dynamic") {
+        self$render(return_widget = TRUE)
+      } else {
+        stop(".get_htmlwidget is meant for use with static and dynamic modes")
+      }
     }
   )
 )
 
 #' @keywords internal
-invoke_static <- function(w) {
+invoke_static <- function(w, return_widget = FALSE) {
   w <- the_anyhtmlwidget(
     esm = w$.get_esm(),
     values = w$.get_values(),
     width = w$.get_width(),
     height = w$.get_height()
   )
+  if(return_widget) {
+    return(w)
+  }
   print(w)
 }
 
 #' @keywords internal
-invoke_dynamic <- function(w) {
+invoke_dynamic <- function(w, return_widget = FALSE) {
   w$.start_server()
   w <- the_anyhtmlwidget(
     esm = w$.get_esm(),
@@ -283,11 +296,14 @@ invoke_dynamic <- function(w) {
     port = w$.get_port(),
     host = w$.get_host()
   )
+  if(return_widget) {
+    return(w)
+  }
   print(w)
 }
 
 #' @keywords internal
-invoke_gadget <- function(w) {
+invoke_gadget <- function(w, return_widget = FALSE) {
   ui <- shiny::tagList(
     anyhtmlwidget_output(output_id = "my_widget", width = '100%', height = '100%')
   )
@@ -322,6 +338,10 @@ invoke_gadget <- function(w) {
     })
   }
 
+  if(return_widget) {
+    return(list(ui = ui, server = server))
+  }
+
   shiny::runGadget(ui, server)
 }
 

tests/testthat.R

@@ -0,0 +1,4 @@
+library(testthat)
+library(anyhtmlwidget)
+
+test_check("anyhtmlwidget")

tests/testthat/test-widget.R

@@ -0,0 +1,128 @@
+library(anyhtmlwidget)
+
+esm <- "
+function render({ el, model }) {
+  el.style.border = '4px solid red';
+  let count = () => model.get('count');
+  let btn = document.createElement('button');
+  btn.innerHTML = `count is ${count()}`;
+  btn.addEventListener('click', () => {
+    model.set('count', count() + 1);
+    model.save_changes();
+  });
+  model.on('change:count', () => {
+    btn.innerHTML = `count is ${count()}`;
+  });
+  el.appendChild(btn);
+}
+export default { render };
+"
+
+test_that("counter widget can be instantiated", {
+  w <- AnyHtmlWidget$new(
+    .esm = esm,
+    .mode = "static",
+    .height='400px',
+    count = 1
+  )
+
+  expect_equal(w$count, 1)
+
+  # Check that getters work
+  expect_equal(w$.get_value("count"), 1)
+  expect_equal(w$.get_esm(), esm)
+  expect_equal(w$.get_values(), list(
+    count = 1
+  ))
+  expect_equal(w$.get_width(), "100%")
+  expect_equal(w$.get_height(), '400px')
+  expect_equal(w$.get_mode(), "static")
+  expect_equal(w$.get_host(), "0.0.0.0")
+  expect_true(is.numeric(w$.get_port()))
+
+  # Check that setters work
+  w$.set_value("count", 3, emit_change = FALSE)
+  expect_equal(w$.get_value("count"), 3)
+
+  # Check that onChange handler works.
+  # Create an empty list to track calls to the handler.
+  change_list <<- list()
+  handle_change <- function(key, new_val) {
+    # Append to the list of { key, val }
+    # pairs of tracked changes
+    change_list <<- append(change_list,
+      list(list(key = key, val = new_val))
+    )
+  }
+  w$.on_change(handle_change)
+
+  w$.set_value("count", 5, emit_change = FALSE)
+  expect_equal(w$.get_value("count"), 5)
+  expect_equal(length(change_list), 0)
+
+  w$.set_value("count", 6, emit_change = TRUE)
+  expect_equal(w$.get_value("count"), 6)
+  expect_equal(length(change_list), 1)
+  expect_equal(change_list[[1]], list(key = "count", val = 6))
+
+  w$.set_value("count", 7, emit_change = TRUE)
+  expect_equal(w$.get_value("count"), 7)
+  expect_equal(length(change_list), 2)
+  expect_equal(change_list[[1]], list(key = "count", val = 6))
+  expect_equal(change_list[[2]], list(key = "count", val = 7))
+})
+
+test_that("invalid mode parameter value results in error", {
+  expect_error(AnyHtmlWidget$new(
+    .esm = esm,
+    .mode = "INVALID",
+    .height='400px',
+    count = 1
+  ), "Invalid widget mode.")
+})
+
+test_that("render return value reflects mode", {
+  static_w <- AnyHtmlWidget$new(
+    .esm = esm,
+    .mode = "static",
+    .height='400px',
+    count = 1
+  )
+
+  render_val <- static_w$render(return_widget = TRUE)
+  expect_equal(class(render_val), c("anyhtmlwidget", "htmlwidget"))
+  render_val2 <- static_w$.get_htmlwidget()
+  expect_equal(class(render_val2), c("anyhtmlwidget", "htmlwidget"))
+
+  dynamic_w <- AnyHtmlWidget$new(
+    .esm = esm,
+    .mode = "dynamic",
+    .height='400px',
+    count = 1
+  )
+  render_val <- dynamic_w$render(return_widget = TRUE)
+  expect_equal(class(render_val), c("anyhtmlwidget", "htmlwidget"))
+  render_val2 <- dynamic_w$.get_htmlwidget()
+  expect_equal(class(render_val2), c("anyhtmlwidget", "htmlwidget"))
+
+  shiny_w <- AnyHtmlWidget$new(
+    .esm = esm,
+    .mode = "shiny",
+    .height='400px',
+    count = 1
+  )
+  expect_error(shiny_w$render(return_widget = TRUE), "render is meant for use with static, gadget, and dynamic modes")
+  expect_error(shiny_w$.get_htmlwidget(), ".get_htmlwidget is meant for use with static and dynamic modes")
+
+  gadget_w <- AnyHtmlWidget$new(
+    .esm = esm,
+    .mode = "gadget",
+    .height='400px',
+    count = 1
+  )
+  render_val <- gadget_w$render(return_widget = TRUE)
+  expect_equal(class(render_val), c("list"))
+  expect_equal(names(render_val), c("ui", "server"))
+  expect_error(gadget_w$.get_htmlwidget(), ".get_htmlwidget is meant for use with static and dynamic modes")
+
+})