R/view-diff.R

Defines functions textTestDiffSingle textTestDiff viewTestDiffSingle viewTestDiff viewTestDiffWidget diffviewer_widget

Documented in diffviewer_widget textTestDiff viewTestDiff viewTestDiffWidget

#' 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
diffviewer_widget <- function(old, new, width = NULL, height = NULL,
  pattern = NULL)
{

  if (xor(assertthat::is.dir(old), assertthat::is.dir(new))) {
      stop("`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$", filename) || grepl("\\.download$", filename)) {
      raw_to_utf8(bin_data)
    } else if (grepl("\\.png$", filename)) {
      paste0("data:image/png;base64,", jsonlite::base64_enc(bin_data))
    } else {
      ""
    }
  }

  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
#'
#' @param appDir Directory of the Shiny application that was tested.
#' @param testname Name of test to compare.
#'
#' @export
viewTestDiffWidget <- function(appDir = ".", testname = NULL) {
  expected <- file.path(appDir, "tests", paste0(testname, "-expected"))
  current  <- file.path(appDir, "tests", 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
#'   \code{\link{textTestDiff}}.
#' @param images Compare screenshot images (only used when \code{interactive} is
#'   FALSE).
#'
#' @return A character vector the same length as \code{testnames}, with
#'   \code{"accept"} or \code{"reject"} for each test.
#'
#' @seealso \code{\link{textTestDiff}} to get a text diff as a string.
#'
#' @import shiny
#' @export
viewTestDiff <- function(appDir = ".", testnames = NULL,
  interactive = base::interactive(), images = TRUE)
{
  if (interactive) {
    if (is.null(testnames)) {
      # Only try to view diffs if there's a -current dir
      testnames <- all_testnames(appDir, "-current")
    }

    message("Differences in current results found for: ", paste(testnames, collapse = " "))

    results <- lapply(testnames, function(testname) {
      message("Viewing diff for ", testname)
      viewTestDiffSingle(appDir, testname)
    })

    names(results) <- testnames
    invisible(results)

  } else {
    # textTestDiff returns a string with a "status" attribute
    result <- textTestDiff(appDir, testnames, images)
    cat(result)
    invisible(attr(result, "status", exact = TRUE))
  }
}


viewTestDiffSingle <- function(appDir = ".", testname = NULL) {
  validate_testname(appDir, testname)

  withr::with_options(
    list(
      shinytest.app.dir = normalizePath(appDir, mustWork = TRUE),
      shinytest.test.name = testname
    ),
    invisible(
      shiny::runApp(system.file("diffviewerapp", package = "shinytest"))
    )
  )
}


#' Get textual diff of test results
#'
#' @inheritParams viewTestDiff
#' @param images Compare screenshot images.
#' @seealso \code{\link{viewTestDiff}} for interactive diff viewer.
#' @export
textTestDiff <- function(appDir = ".", testnames = NULL, images = TRUE) {
  if (is.null(testnames)) {
    testnames <- all_testnames(appDir)
  }

  diff_results <- lapply(
    testnames,
    function(testname) {
      result <- textTestDiffSingle(appDir, testname, images)

      # 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) {
  validate_testname(appDir, testname)

  current_dir  <- file.path(appDir, "tests", paste0(testname, "-current"))
  expected_dir <- file.path(appDir, "tests", paste0(testname, "-expected"))

  if (dir_exists(expected_dir) && !dir_exists(current_dir)) {
    return(
      structure("No differences between expected 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)
}
MangoTheCat/shinytest documentation built on April 20, 2019, 3:24 p.m.