#' Creat an htmlwidget that shows differences between files or directories
#'
#' This function can be used for viewing differences between current test
#' results and the expected results
#'
#' @param old,new Names of the old and new directories to compare.
#' Alternatively, they can be a character vectors of specific files to
#' compare.
#' @param pattern A filter to apply to the old and new directories.
#' @param width Width of the htmlwidget.
#' @param height Height of the htmlwidget
#'
#' @export
#' @keywords internal
diffviewer_widget <- function(old, new, width = NULL, height = NULL,
pattern = NULL)
{
if (xor(assertthat::is.dir(old), assertthat::is.dir(new))) {
abort("`old` and `new` must both be directories, or character vectors of filenames.")
}
# If `old` or `new` are directories, get a list of filenames from both directories
if (assertthat::is.dir(old)) {
all_filenames <- sort(unique(c(
dir(old, recursive = TRUE, pattern = pattern),
dir(new, recursive = TRUE, pattern = pattern)
)))
}
# TODO: Make sure old and new are the same length. Needed if someone passes
# in files directly.
#
# Also, make it work with file lists in general.
get_file_contents <- function(filename) {
if (!file.exists(filename)) {
return(NULL)
}
bin_data <- read_raw(filename)
# Assume .json and .download files are text
if (grepl("\\.(json|download|txt)$", filename)) {
raw_to_utf8(bin_data)
} else if (grepl("\\.png$", filename)) {
paste0("data:image/png;base64,", jsonlite::base64_enc(bin_data))
} else {
# provide hash of file contents as a proxy to display binary differences
paste0(
"{shinytest} - SHA-1 hash of file contents: ", digest::digest(bin_data, algo = "sha1"), "\n",
"\n",
"Currently, only `.json`, `.download`, `.txt`, and `.png` file extensions will display full differences."
)
}
}
get_both_file_contents <- function(filename) {
list(
filename = filename,
old = get_file_contents(file.path(old, filename)),
new = get_file_contents(file.path(new, filename))
)
}
diff_data <- lapply(all_filenames, get_both_file_contents)
htmlwidgets::createWidget(
name = "diffviewer",
list(
diff_data = diff_data
),
sizingPolicy = htmlwidgets::sizingPolicy(
defaultWidth = "100%",
defaultHeight = "100%",
browser.padding = 10,
viewer.fill = FALSE
),
package = "shinytest"
)
}
#' Interactive viewer widget for changes in test results
#'
#' @inheritParams viewTestDiff
#' @param testname Name of test to compare.
#'
#' @export
#' @keywords internal
viewTestDiffWidget <- function(appDir = ".", testname = NULL, suffix = NULL) {
testDir <- findTestsDir(appDir, quiet = TRUE)
expected <- file.path(testDir, paste0(testname, "-expected", normalize_suffix(suffix)))
current <- file.path(testDir, paste0(testname, "-current"))
diffviewer_widget(expected, current)
}
#' View differences in test results
#'
#' @param appDir Directory of the Shiny application that was tested.
#' @param testnames A character vector of names of tests to compare. If NULL,
#' compare all test results for which there are differences.
#' @param interactive If TRUE, use the interactive diff viewer, which runs in a
#' Shiny app. If FALSE, print a textual diff, generated by
#' [textTestDiff()].
#' @param images Compare screenshot images (only used when `interactive` is
#' FALSE).
#' @param suffix An optional suffix for the expected results directory. For
#' example, if the suffix is `"mac"`, the expected directory would be
#' `mytest-expected-mac`.
#'
#' @return A character vector the same length as `testnames`, with
#' `"accept"` or `"reject"` for each test.
#'
#' @seealso [textTestDiff()] to get a text diff as a string.
#'
#' @import shiny
#' @export
#' @keywords internal
viewTestDiff <- function(
appDir = ".",
testnames = NULL,
interactive = is_interactive(),
images = TRUE,
suffix = NULL
) {
testDir <- findTestsDir(appDir, quiet=TRUE)
if (interactive) {
if (is.null(testnames)) {
# Only try to view diffs if there's a -current dir
testnames <- all_testnames(testDir, "-current")
}
inform(c("Differences in current results found for: ", testnames))
results <- lapply(testnames, function(testname) {
inform(paste0("Viewing diff for ", testname))
viewTestDiffSingle(appDir, testname, suffix)
})
names(results) <- testnames
invisible(results)
} else {
# textTestDiff returns a string with a "status" attribute
result <- textTestDiff(appDir, testnames, images, suffix)
cat(result)
invisible(attr(result, "status", exact = TRUE))
}
}
viewTestDiffSingle <- function(appDir = ".", testname = NULL, suffix = NULL) {
testDir <- findTestsDir(appDir, quiet=TRUE)
validate_testname(testDir, testname)
withr::with_options(
list(
shinytest.app.dir = normalizePath(appDir, mustWork = TRUE),
shinytest.test.name = testname,
shinytest.suffix = suffix
),
invisible(
shiny::runApp(system.file("diffviewerapp", package = "shinytest"))
)
)
}
#' Get textual diff of test results
#'
#' @inheritParams viewTestDiff
#' @param images Compare screenshot images.
#' @seealso [viewTestDiff()] for interactive diff viewer.
#' @export
#' @keywords internal
textTestDiff <- function(
appDir = ".",
testnames = NULL,
images = TRUE,
suffix = NULL
) {
testDir <- findTestsDir(appDir, quiet=TRUE)
if (is.null(testnames)) {
testnames <- all_testnames(testDir)
}
diff_results <- lapply(
testnames,
function(testname) {
result <- textTestDiffSingle(appDir, testname, images, suffix)
# Need to pass along status attribute
structure(
paste0(
"==== ", testname, " ====\n",
result
),
status = attr(result, "status", exact = TRUE)
)
}
)
# Each result object will have a "status" attribute, which is "accept" or "reject"
status <- vapply(diff_results, function(result) attr(result, "status", exact = TRUE), "")
names(status) <- testnames
structure(
paste(diff_results, collapse = "\n"),
status = status
)
}
textTestDiffSingle <- function(
appDir = ".",
testname = NULL,
images = TRUE,
suffix = NULL
) {
testDir <- findTestsDir(appDir, quiet=TRUE)
validate_testname(testDir, testname)
current_dir <- file.path(testDir, paste0(testname, "-current"))
expected_dir <- file.path(testDir, paste0(testname, "-expected", normalize_suffix(suffix)))
if (dir_exists(expected_dir) && !dir_exists(current_dir)) {
return(
structure(
paste0(
"No differences between expected", normalize_suffix(suffix),
"and current results"),
status = "accept"
)
)
}
if (images) {
filter_fun <- NULL
} else {
# If we're not using images, then delete PNG files and remove the
# hashes from JSON.
filter_fun <- remove_image_hashes_and_files
}
diff_files(expected_dir, current_dir, filter_fun)
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.