Add chromote as headless browser for testing

.github/workflows/tests.yaml

@@ -28,10 +28,7 @@ jobs:
       - run: /usr/bin/sudo DEBIAN_FRONTEND=noninteractive apt install texlive texlive-fonts-extra -y
       - uses: r-lib/actions/setup-r@v2
       - uses: r-lib/actions/setup-r-dependencies@v2
-        with: 
-          extra-packages: digest, RJSONIO, gtable, plyr, reshape2, scales, knitr
-
-
+
       - name: install package
         run: R CMD INSTALL .
 

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: animint2
 Title: Animated Interactive Grammar of Graphics
-Version: 2024.3.12
+Version: 2024.6.6
 URL: https://animint.github.io/animint2/
 BugReports: https://github.com/animint/animint2/issues
 Authors@R: c(
@@ -100,7 +100,8 @@ Suggests:
     nlme,
     rpart,
     svglite,
-    ggplot2
+    ggplot2,
+    chromote
 Remotes: ropensci/RSelenium@v1.7.4
 License: GPL-3
 Encoding: UTF-8

NEWS.md

@@ -1,3 +1,7 @@
+# Changes in version 2024.6.6 (PR#126)
+
+  - Add chromote as headless browser for testing and remove phantomjs/firefox support
+
 # Changes in version 2024.3.12 (PR#119)
 
   - Add validation checks for duplicate args passed geom and aes

tests/testthat.R

@@ -39,13 +39,7 @@ if(filter == ""){
   filter <- NULL
 }
 message(gh.action)
-if(FALSE){
-  tests_init("chrome")
-}else if(interactive() | (gh.action == "ENABLED")) {
-  tests_init("firefox")
-} else {
-  tests_init()
-}
+tests_init()
 
 tests_run(filter=filter)
 tests_exit()

tests/testthat/helper-HTML.R

@@ -1,116 +1,105 @@
-#' Apply `animint2dir` to a list ggplots and extract the (rendered) page source via RSelenium
-#'
-#' @param plotList A named list of ggplot2 objects
-animint2HTML <- function(plotList) {
-  unlink("animint-htmltest", recursive=TRUE)
-  res <- animint2dir(plotList, out.dir = "animint-htmltest",
-                     open.browser = FALSE)
-  remDr$refresh()
-  Sys.sleep(1)
-  res$html <- getHTML()
-  ## [ERROR - 2019-06-05T18:30:55.358Z] Session [e7c4e500-871e-11e9-a9b5-8dab1f486f7e] - page.onError - msg: TypeError: 'undefined' is not an object (evaluating 's_info.type')
-  ## [ERROR - 2019-06-05T18:30:55.360Z] Session [e7c4e500-871e-11e9-a9b5-8dab1f486f7e] - page.onError - stack:
-  ##   (anonymous function) (http://localhost:4848/animint-htmltest/animint.js:2535)
-  ## print(sapply(res$selectors, "[[", "type"))
-  res
-}
-getHTML <- function(){
-  XML::htmlParse(remDr$getPageSource(), asText = TRUE)
-}
-#' Initiate external processes necessary for running tests.
-#'
-#' Initiates a local file server and remote driver.
-#'
-#' @param browserName Name of the browser to use for testing.
-#' See ?RSelenium::remoteDriver for details.
-#' @param dir character string with the path to animint's source code. Defaults to current directory
-#' @param port port portnumber used for local file server
-#' @param ... list of additional options passed onto RSelenium::remoteDriver
-#' @return invisible(TRUE)
-#' @export
-#' @seealso \link{tests_run}
-#'
-tests_init <- function(browserName = "phantomjs", dir = ".", port = 4848, ...) {
-  # try to exit out of previously initated processes
-  ex <- tests_exit()
-  # start a non-blocking local file server under path/to/animint/tests/testhat
-  testPath <- find_test_path(dir)
-  run_servr(port = port, directory = testPath)
-  # animint tests are performed in path/to/testthat/animint-htmltest/
-  # note this path has to match the out.dir argument in animint2THML...
-  testDir <- file.path(testPath, "animint-htmltest")
-  # if the htmltest directory exists, wipe clean, then create an empty folder
-  unlink(testDir, recursive = TRUE)
-  # start-up remote driver
-  remotePort <- 4444L
-  OS <- Sys.info()[['sysname']]
-  if(OS == "Linux") {
-    animint_server <- "localhost"   
-  }
-  if(OS == "Windows" || OS == "Darwin") {
-    animint_server <- "host.docker.internal"
-  }
-  if(browserName == "chrome"){
-    chrome.session <- chromote::ChromoteSession$new()
-    chrome.session$view()
-    chrome.session$refresh <- function()chrome.session$Page$reload()
-    chrome.session$navigate <- function(u){
-      chrome.session$Page$navigate(u)
-    }
-    chrome.session$getPageSource <- function(){
-      doc <- chrome.session$DOM$getDocument()
-      chrome.session$DOM$getOuterHTML(doc$root$nodeId)$outerHTML
-    }
-    remDr <<- chrome.session
-  }else{
-    if (browserName == "phantomjs") {
-      message("Starting phantomjs binary. To shut it down, run: \n pJS$stop()")
-      pJS <<- wdman::phantomjs(
-        port = remotePort,
-        phantomver = "latest"
-      )
-      ## Give time for phantomjs binary to start
-      animint_server <- "localhost"
-      Sys.sleep(8)  
-    } else if(browserName=="firefox"){
-      ## If using firefox, you'll need to run selenium-firefox docker image in order to make it work correctly.
-      ## We're using docker to avoid version incompatibility issues.
-      message("You need to run selenium docker image(selenium/standalone-firefox:2.53.0) as specified in docs(https://github.com/tdhock/animint2/wiki/Testing). \nNote: Ignore if already running.")
-    }else stop("unrecognized browser name")
-    remDr <<- RSelenium::remoteDriver(
-      port = remotePort,
-      browser = browserName,
-      )
-    ## wait for the remote driver to start-up
-    Sys.sleep(6)
-    remDr$open(silent = TRUE)
-    ## some tests don't run reliably with phantomjs (see tests-widerect.R)
-    Sys.setenv("ANIMINT_BROWSER" = browserName)
-    ## wait a maximum of 30 seconds when searchinsg for elements.
-    remDr$setTimeout(type = "implicit", milliseconds = 30000)
-    ## wait a maximum of 30 seconds for a particular type of operation to execute
-    remDr$setTimeout(type = "page load", milliseconds = 30000)
-    ## if we navigate to localhost:%s/htmltest directly, some browsers will
-    ## redirect to www.htmltest.com. A 'safer' approach is to navigate, then click.
-  }
-  remDr$navigate(sprintf("http://%s:%s/animint-htmltest/", animint_server, port))
-  ## Why not just navigate to the right URL to begin with?
-  ## e <- remDr$findElement("xpath", "//a[@href='animint-htmltest/']")
-  ## e$clickElement()
-  invisible(TRUE)
-}
-## get both horizontal and vertical grid lines
-get_grid_lines <- function(html, p_name, grid_class){
-  path.i <-
-    '//svg[@id="plot_%s"]//g[@class="grid_%s"]//g[@class="%s"]//line'
-  path.hor <- sprintf(path.i, p_name, grid_class, "y")
-  path.vert <- sprintf(path.i, p_name, grid_class, "x")
-  nodes_h <- getNodeSet(html, path.hor)
-  nodes_v <- getNodeSet(html, path.vert)
-  # take x1, x2, y1, y2 values only
-  attr_h <- sapply(nodes_h, xmlAttrs)[1:4, ]
-  attr_v <- sapply(nodes_v, xmlAttrs)[1:4, ]
-  attr_h <- apply(attr_h, 2, as.numeric)
-  attr_v <- apply(attr_v, 2, as.numeric)
-  return(list(hor=attr_h, vert=attr_v))
-}
+#' Apply `animint2dir` to a list ggplots and extract the (rendered) page source via RSelenium
+#'
+#' @param plotList A named list of ggplot2 objects
+animint2HTML <- function(plotList) {
+  unlink("animint-htmltest", recursive=TRUE)
+  res <- animint2dir(plotList, out.dir = "animint-htmltest",
+                     open.browser = FALSE)
+  remDr$refresh()
+  Sys.sleep(2)
+  res$html <- getHTML()
+  ## [ERROR - 2019-06-05T18:30:55.358Z] Session [e7c4e500-871e-11e9-a9b5-8dab1f486f7e] - page.onError - msg: TypeError: 'undefined' is not an object (evaluating 's_info.type')
+  ## [ERROR - 2019-06-05T18:30:55.360Z] Session [e7c4e500-871e-11e9-a9b5-8dab1f486f7e] - page.onError - stack:
+  ##   (anonymous function) (http://localhost:4848/animint-htmltest/animint.js:2535)
+  ## print(sapply(res$selectors, "[[", "type"))
+  res
+}
+getHTML <- function(){
+  XML::htmlParse(remDr$getPageSource(), asText = TRUE)
+}
+#' Initiate external processes necessary for running tests.
+#'
+#' Initiates a local file server and remote driver.
+#'
+#' @param browserName Name of the browser to use for testing.
+#' See ?RSelenium::remoteDriver for details.
+#' @param dir character string with the path to animint's source code. Defaults to current directory
+#' @param port port portnumber used for local file server
+#' @param ... list of additional options passed onto RSelenium::remoteDriver
+#' @return invisible(TRUE)
+#' @export
+#' @seealso \link{tests_run}
+#'
+tests_init <- function(dir = ".", ...) {
+  # try to exit out of previously initated processes
+  ex <- tests_exit()
+  # start a non-blocking local file server under path/to/animint/tests/testhat
+  testPath <- find_test_path(dir)
+  run_servr(port = 4848, directory = testPath)
+  # animint tests are performed in path/to/testthat/animint-htmltest/
+  # note this path has to match the out.dir argument in animint2THML...
+  testDir <- file.path(testPath, "animint-htmltest")
+  # if the htmltest directory exists, wipe clean, then create an empty folder
+  unlink(testDir, recursive = TRUE)
+  chrome.session <- chromote::ChromoteSession$new()
+  chrome.session$view()
+  chrome.session$refresh <- function(){
+    ## from https://github.com/rstudio/chromote?tab=readme-ov-file#loading-a-page-reliably
+    prom <- chrome.session$Page$loadEventFired(wait_ = FALSE)  # Get the promise for the loadEventFired
+    chrome.session$Page$reload()
+    # Block until p resolves
+    chrome.session$wait_for(prom)
+  }
+  chrome.session$navigate <- function(u){
+    chrome.session$Page$navigate(u)
+    }
+  chrome.session$getPageSource <- function(){
+    doc <- chrome.session$DOM$getDocument()
+    chrome.session$DOM$getOuterHTML(doc$root$nodeId)$outerHTML
+    }
+  remDr <<- chrome.session
+  remDr$navigate("http://localhost:4848/animint-htmltest/")
+  invisible(TRUE)
+}
+## get both horizontal and vertical grid lines
+get_grid_lines <- function(html, p_name, grid_class){
+  path.i <-
+    '//svg[@id="plot_%s"]//g[@class="grid_%s"]//g[@class="%s"]//line'
+  path.hor <- sprintf(path.i, p_name, grid_class, "y")
+  path.vert <- sprintf(path.i, p_name, grid_class, "x")
+  nodes_h <- getNodeSet(html, path.hor)
+  nodes_v <- getNodeSet(html, path.vert)
+  # take x1, x2, y1, y2 values only
+  attr_h <- sapply(nodes_h, xmlAttrs)[1:4, ]
+  attr_v <- sapply(nodes_v, xmlAttrs)[1:4, ]
+  attr_h <- apply(attr_h, 2, as.numeric)
+  attr_v <- apply(attr_v, 2, as.numeric)
+  return(list(hor=attr_h, vert=attr_v))
+}
+### The hex codes come from
+### https://developer.mozilla.org/en-US/docs/Web/API/UI_Events/Keyboard_event_key_values
+key2hex_code <- c(
+  Backspace="08",
+  Enter="0D",
+  ArrowDown="28")
+### https://chromedevtools.github.io/devtools-protocol/tot/Input/ says
+### that dispatchKeyEvent() requires DOM key codes (in decimal) for
+### the windowsVirtualKeyCode and nativeVirtualKeyCode arguments.
+key2dec_code <- structure(
+  strtoi(key2hex_code,base=16),
+  names=names(key2hex_code))
+# Function to send a key event
+sendKey <- function(key) {
+  stopifnot(is.character(key))
+  for (type in c("keyDown", "keyUp")) {
+    remDr$Input$dispatchKeyEvent(type = type, key = key, code = key, windowsVirtualKeyCode = key2dec_code[[key]], nativeVirtualKeyCode = key2dec_code[[key]])
+  }
+}
+
+getClassBound <- function(geom.class, position){
+  script.txt <- sprintf(
+    'document.getElementsByClassName("%s")[0].getBoundingClientRect().%s', 
+    geom.class, position)
+  Sys.sleep(2)
+  runtime_evaluate(script=script.txt)
+}