R/view-diff.R

In shinytest: Test Shiny Apps

#' 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)
}