Wait in click()

NEWS.md

@@ -1,6 +1,7 @@
 # rvest (development version)
 
 * New example vignette displays the same starwars data but rendered dynamically using JS, so you need to use `read_html_live()` to get the data.
+* The `click()` method for `LiveHTML` objects gains a `new_page` argument to deal with situations where a click loads a new web page (@jonthegeek, #405).
 
 # rvest 1.0.4
 

R/live.R

@@ -87,12 +87,11 @@ LiveHTML <- R6::R6Class(
 
       self$session$Network$setUserAgentOverride("Mozilla/5.0 (Macintosh; Intel Mac OS X 10_15_7) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/121.0.0.0 Safari/537.36")
 
+      self$session$Page$loadEventFired(callback_ = private$refresh_root)
       # https://github.com/rstudio/chromote/issues/102
       p <- self$session$Page$loadEventFired(wait_ = FALSE)
       self$session$Page$navigate(url, wait_ = FALSE)
       self$session$wait_for(p)
-
-      private$root_id <- self$session$DOM$getDocument(0)$root$nodeId
     },
 
     #' @description Called when `print()`ed
@@ -147,6 +146,8 @@ LiveHTML <- R6::R6Class(
       center_x <- mean(content_quad[c(1, 3, 5, 7)])
       center_y <- mean(content_quad[c(2, 4, 6, 8)])
 
+      private$loadEvent_promise <- self$session$Page$loadEventFired(wait_ = FALSE)
+
       # https://chromedevtools.github.io/devtools-protocol/1-3/Input/#method-dispatchMouseEvent
       self$session$Input$dispatchMouseEvent(
         type = "mouseMoved",
@@ -170,6 +171,7 @@ LiveHTML <- R6::R6Class(
           button = "left"
         )
       }
+
       invisible(self)
     },
 
@@ -224,6 +226,7 @@ LiveHTML <- R6::R6Class(
         deltaX = left,
         deltaY = top
       )
+
       invisible(self)
     },
 
@@ -264,18 +267,20 @@ LiveHTML <- R6::R6Class(
   private = list(
     root_id = NULL,
 
+    loadEvent_promise = NULL,
+
     check_active = function() {
       if (new_chromote && !self$session$is_active()) {
         suppressMessages({
           self$session <- self$session$respawn()
-          private$root_id <- self$session$DOM$getDocument(0)$root$nodeId
+          private$refresh_root()
         })
       }
     },
 
     wait_for_selector = function(css, timeout = 5) {
       done <- now() + timeout
-      while(now() < done) {
+      while (now() < done) {
         nodes <- private$find_nodes(css)
         if (length(nodes) > 0) {
           return(nodes)
@@ -289,7 +294,8 @@ LiveHTML <- R6::R6Class(
     find_nodes = function(css, xpath) {
       check_exclusive(css, xpath)
       if (!missing(css)) {
-        unlist(self$session$DOM$querySelectorAll(private$root_id, css)$nodeIds)
+        node_ids <- private$nodes_from_css(css)
+        unlist(node_ids)
       } else {
         search <- glue::glue("
           (function() {{
@@ -313,6 +319,20 @@ LiveHTML <- R6::R6Class(
       }
     },
 
+    nodes_from_css = function(css, retry = TRUE) {
+      try_fetch(
+        self$session$DOM$querySelectorAll(private$root_id, css)$nodeIds,
+        error = function(cnd) {
+          if (retry) {
+            self$session$wait_for(private$loadEvent_promise)
+            private$nodes_from_css(css, retry = FALSE)
+          } else {
+            cli::cli_abort(cnd)
+          }
+        }
+      )
+    },
+
     # Inspired by https://github.com/rstudio/shinytest2/blob/v1/R/chromote-methods.R
     call_node_method = function(node_id, method, ...) {
       js_fun <- paste0("function() { return this", method, "}")
@@ -324,6 +344,10 @@ LiveHTML <- R6::R6Class(
     object_id = function(node_id) {
       # https://chromedevtools.github.io/devtools-protocol/tot/DOM/#method-resolveNode
       self$session$DOM$resolveNode(node_id)$object$objectId
+    },
+
+    refresh_root = function(...) {
+      private$root_id <- self$session$DOM$getDocument(0)$root$nodeId
     }
   )
 )

tests/testthat/_snaps/session.md

@@ -7,12 +7,12 @@
       <session> https://hadley.nz/
         Status: 200
         Type:   text/html; charset=utf-8
-        Size:   821273
+        Size:   821905
     Code
       expect_true(is.session(s))
       s <- session_follow_link(s, css = "p a")
     Message
-      Navigating to <http://rstudio.com>.
+      Navigating to <https://posit.co>.
     Code
       session_history(s)
     Output

tests/testthat/html/navigate1.html

@@ -0,0 +1,8 @@
+<!DOCTYPE html>
+<html>
+<head>
+  <title>Navigate 1</title>
+</head>
+<body>
+  <a href="navigate2.html">Navigate to Page 2</a>
+</body>

tests/testthat/html/navigate2.html

@@ -0,0 +1,8 @@
+<!DOCTYPE html>
+<html>
+<head>
+  <title>Navigate 2</title>
+</head>
+<body>
+  <p>Success!</p>
+</body>

tests/testthat/test-live.R

@@ -50,6 +50,14 @@ test_that("can click a button", {
   expect_equal(html_text(html_element(sess, "p")), "double clicked")
 })
 
+test_that("can find elements after click that navigates", {
+  skip_if_no_chromote()
+
+  sess <- read_html_live(html_test_path("navigate1"))
+  sess$click("a")
+  expect_equal(html_text2(html_element(sess, "p")), "Success!")
+})
+
 test_that("can scroll in various ways", {
   skip_if_no_chromote()
 
@@ -88,7 +96,6 @@ test_that("can press special keys",{
   expect_equal(html_text(html_element(sess, "#keyInfo")), "]/BracketRight")
 })
 
-
 # as_key_desc -------------------------------------------------------------
 
 test_that("gracefully errors on bad inputs", {