diff --git a/.github/workflows/deploy.yml b/.github/workflows/deploy.yml index fa59df3..2f1fca1 100644 --- a/.github/workflows/deploy.yml +++ b/.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 diff --git a/R/widget.R b/R/widget.R index 4fc7d9b..7900524 100644 --- a/R/widget.R +++ b/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) } diff --git a/tests/testthat.R b/tests/testthat.R new file mode 100644 index 0000000..223f0e5 --- /dev/null +++ b/tests/testthat.R @@ -0,0 +1,4 @@ +library(testthat) +library(anyhtmlwidget) + +test_check("anyhtmlwidget") \ No newline at end of file diff --git a/tests/testthat/test-widget.R b/tests/testthat/test-widget.R new file mode 100644 index 0000000..e4ffe48 --- /dev/null +++ b/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") + +}) \ No newline at end of file