sanitycheckr: Checks Package Using Sanity Checks

get_docker_path <- function() {
  docker_path <- Sys.which("docker")
  if (!nzchar(docker_path)) {
    stop("Docker must be installed for this package to work; see https://www.docker.com/")
  }
  if (system2(docker_path, "info", stdout = FALSE, stderr = FALSE)) {
    stop("You must start the docker daemon to continue; see https://www.docker.com/")
  }
  return(docker_path)
}

exec_docker <- function(cmd) {
  system2(get_docker_path(), cmd)
}

#' Test for docker image
#'
#' @seealso \url{https://hub.docker.com/r/rocker/r-devel-san/}
#'
#' @rdname image
#' @export
check_for_image <- function() {
  return(0 == system2(get_docker_path(), "image info sanitycheckr", stdout = FALSE, stderr = FALSE))
}

#' Remove docker image
#'
#' @rdname image
#' @export
remove_image <- function() {
  system2(get_docker_path(), paste0("image rm sanitycheckr"), stdout = FALSE, stderr = FALSE)
}

#' Build the docker image
#'
#' @param docker_file alternate path to docker file if not null
#' @rdname image
#' @export
build_image <- function(docker_file = NULL) {
  if (is.null(docker_file)) {
    docker_file <- system.file("docker/Dockerfile", package = "sanitycheckr")
  }
  if (!file.exists(docker_file)) stop("Cannot find Dockerfile")
  build_cmd <- paste("build -t sanitycheckr -f", docker_file, tempdir())
  if (exec_docker(build_cmd)) stop("Failed to build docker image")
  invisible()
}

run_r_script <- function(cmd, mnt = "") {
  if (nzchar(mnt)) {
    mnt <- paste0("-v ", normalizePath(mnt), ":/home/docker ")
  }
  r_cmd <- "Rscript -e "
  docker_cmd <- paste0("run ", mnt, "sanitycheckr ", r_cmd, shQuote(cmd))
  exec_docker(docker_cmd)
}

get_full_path <- function(pkg = ".") {
  fp <- normalizePath(pkg)
  if (!dir.exists(fp)) stop("Invalid package directory")
  return(fp)
}

get_pkg_dir <- function(pkg = ".") basename(get_full_path(pkg))
get_pkg_parent_dir <- function(pkg = ".") dirname(get_full_path(pkg))
get_pkg_docker_dir <- function(pkg = ".") paste0("/home/docker/", get_pkg_dir(pkg))

run_check <- function(pkg = ".") {
  cmd <- paste0(
    "options(Ncpus = 2, pkgType = \"source\"); ",
    "setwd(\"", get_pkg_docker_dir(pkg), "\"); ",
    "devtools::install_deps(dependencies = TRUE); ",
    "built = devtools::build(path = tempdir()); ",
    "setwd(tempdir()); untar(built); ",
    "setwd(\"", get_pkg_dir(pkg), "\"); ",
    "devtools::check(check_dir = \"/home/docker\"); ",
    "if (devtools::uses_testthat()) print(devtools::test())"
  )
  run_r_script(cmd, mnt = get_pkg_parent_dir(pkg))
}

#' Run check with sanitizers
#'
#' Runs R CMD check with address checking
#'
#' @param pkg the path to the package to be tested
#'
#' @details The package will download and build a docker image containing a
#'   specially built R binary that has address sanitizing enabled. It will also
#'   check for undefined behavior. The results of the check should appear in the
#'   parent directory of the package directory. You must install docker and
#'   start the daemon for this package to work.
#'
#' @return The Rcheck directory will be written to the parent of the package
#'   directory. If the package uses \code{\link{testthat}}, the testing results
#'   will be printed to the console.
#'
#' @note This can take a very long time to run, so you may wish to run it in a
#'   separate R session.
#'
#' @seealso \url{https://hub.docker.com/r/rocker/r-devel-san/}
#'
#' @export
sanity_check <- function(pkg = ".") {
  build_image()
  run_check(pkg)
}