library(shinytest2)
selector_exists <- function(selector, ...) {
if (length(c(...))) {
selector <- paste(selector, paste(c(...), collapse = " "))
}
sprintf(
"document.querySelector('%s') ? true : false",
selector
)
}
selector_doesnt_exist <- function(selector, ...) {
if (length(c(...))) {
selector <- paste(selector, paste(c(...), collapse = " "))
}
sprintf(
"document.querySelector('%s') ? false : true",
selector
)
}
selector_classlist <- function(selector, ...) {
if (length(c(...))) {
selector <- paste(selector, paste(c(...), collapse = " "))
}
sprintf(
"[...document.querySelector('%s').classList]",
selector
)
}
selector_attributes <- function(selector, ...) {
if (length(c(...))) {
selector <- paste(selector, paste(c(...), collapse = " "))
}
sprintf(
"{
const el = document.querySelector('%s')
!el ? {} : el.getAttributeNames()
.reduce((acc, attr) => {
acc[attr] = el.getAttribute(attr)
return acc
}, {})
}",
selector
)
}
selector_computed_style <- function(selector, ...) {
if (length(c(...))) {
selector <- paste(selector, paste(c(...), collapse = " "))
}
sprintf(
"{
const el = document.querySelector('%s')
if (el) {
const compStyle = window.getComputedStyle(el)
Array.from(compStyle).reduce((acc, attr) => {
acc[attr] = compStyle.getPropertyValue(attr)
return acc
}, {})
}
}",
selector
)
}
selector_coordinates <- function(selector, ...) {
if (length(c(...))) {
selector <- paste(selector, paste(c(...), collapse = " "))
}
sprintf(
"(function() {
const el = document.querySelector('%s')
if (!el) {
return undefined
}
const {top, right, bottom, left, width, height, x, y} = el.getBoundingClientRect()
return {top, right, bottom, left, width, height, x, y}
})()",
selector
)
}
get_editor_value <- function(selector, ...) {
if (length(c(...))) {
selector <- paste(selector, paste(c(...), collapse = " "))
}
sprintf(
"ace.edit(document.querySelector('%s')).getValue()",
selector
)
}
editor_has_focus <- function(selector, ...) {
if (length(c(...))) {
selector <- paste(selector, paste(c(...), collapse = " "))
}
sprintf(
"$(':focus')[0] === document.querySelector('%s textarea')",
selector
)
}
exercise_selector <- function(id) {
sprintf(
"#tutorial-exercise-%s-input",
id
)
}
exercise_selector_editor <- function(id) {
sprintf(
"%s .ace_editor",
exercise_selector(id)
)
}
exercise_selector_hint_btn <- function(id) {
sprintf(
"%s .btn-tutorial-hint",
exercise_selector(id)
)
}
exercise_selector_run_btn <- function(id) {
sprintf(
"%s .btn-tutorial-run",
exercise_selector(id)
)
}
exercise_selector_hint_popover <- function(id) {
sprintf(
"%s > .tutorial-panel-heading .tutorial-solution-popover",
exercise_selector(id)
)
}
exercise_selector_hint_src_div <- function(id) {
sprintf("#section-%s-hint.tutorial-hint", id)
}
exercise_selector_hint_panel <- function(id) {
sprintf('.tutorial-exercise[data-label="%s"] .tutorial-hint-panel', id)
}
exercise_selector_output <- function(id) {
sprintf(
"#tutorial-exercise-%s-output",
id
)
}
exercise_has_output <- function(id) {
sprintf(
"document.querySelector('%s').children.length > 0 ? true : false",
exercise_selector_output(id)
)
}
app_real_click <- function(app, selector, ...) {
chrome <- app$get_chromote_session()
dims <- app$get_js(selector_coordinates(selector, ...))
for (event in c("mousePressed", "mouseReleased")) {
chrome$Input$dispatchMouseEvent(
type = event,
x = dims$left + dims$width / 2,
y = dims$top + dims$height / 2,
clickCount = 1,
pointerType = "mouse",
button = "left",
buttons = 1
)
}
invisible(app)
}
if (!"expect" %in% names(shinytest2::AppDriver$public_methods)) {
# shinytest2::AppDriver$set("public", "with", function(expr) {
# expr <- rlang::enexpr(expr)
# rlang::eval_tidy(expr, data = rlang::new_data_mask(self))
# invisible(self)
# })
shinytest2::AppDriver$set("public", "expect", function(name, object, expected, ...) {
stopifnot(length(name) == 1)
name <- tolower(name)
if (identical(name, "succeed")) {
testthat::succeed(...)
return(invisible(self))
}
allowed_expectactions <- c(
"null", "true", "equal", "match", "false", "length", "no_match", "setequal"
)
if (!name %in% allowed_expectactions) {
rlang::abort(sprintf(
"'%s' is not one of the supported expectations: %s",
name,
paste(allowed_expectactions, collapse = ", ")
))
}
dots <- list(...)
self_mask <- rlang::new_data_mask(self)
if (!missing(object)) {
object <- rlang::enquo(object)
dots$object <- rlang::eval_tidy(object, self_mask)
}
if (!missing(expected)) {
expected <- rlang::enquo(expected)
dots$expected <- rlang::eval_tidy(expected, self_mask)
}
call <- rlang::call2(.fn = paste0("expect_", name), !!!dots, .ns = "testthat")
rlang::eval_bare(call)
invisible(self)
})
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.