R/compress_images_setup.R

In ardata-fr/cookimage: Tools for images

#' @importFrom tools R_user_dir
working_directory <- function(){
  dir <- R_user_dir(package = "cookimage", which = "data")
  file.path(dir, "compress-images")
}

#' @title Is 'compress-images' available
#' @description Checks if 'compress-images' is available within a directory of the user.
#' @return a single logical value.
#' @export
#' @examples
#' compress_images_available()
#' @family tools for 'compress-images'
compress_images_available <- function(){
  dir.exists(working_directory())
}

#' @export
#' @title Uninstall 'compress-images'
#' @description Removes 'compress-images'.
#' @return a single logical value, FALSE if the operation failed, TRUE otherwise.
#' @family tools for 'compress-images'
#' @examples
#' library(locatexec)
#'
#' if(exec_available("npm") &&
#'    compress_images_available()) {
#'   compress_images_uninstall()
#'   compress_images_install()
#' }
#' @family tools for 'compress-images'
compress_images_uninstall <- function(){
  app_dir <- working_directory()
  unlink(app_dir, recursive = TRUE, force = TRUE)
  invisible(NULL)
}


#' @export
#' @importFrom locatexec npm_exec
#' @title Install 'compress-images'
#' @description Downloads and installs 'compress-images'
#' (a "JavaScript" tool for image compression) in the user data directory.
#' @param force Whether to force to install (override) 'compress-images'.
#' @return a single logical value, FALSE if the operation failed, TRUE otherwise.
#' @family tools for 'compress-images'
#' @examples
#' library(locatexec)
#' if(exec_available("node") && !compress_images_available()){
#'   compress_images_install()
#'   compress_images_uninstall()
#' }
compress_images_install <- function(force = FALSE){

  exec_available("npm", error = TRUE)

  app_dir <- working_directory()

  de <- dir.exists(app_dir)
  if(de && !force){
    stop("The directory \"", app_dir, "\" exists. Please either delete it, ",
         "or use compress_images_install(force = TRUE).")
  } else if(de && force){
    unlink(app_dir, recursive = TRUE, force = TRUE)
  }

  dir.create(app_dir, showWarnings = FALSE, recursive = TRUE)

  package.json <- system.file(package = "cookimage", "compress-images", "package.json")
  file.copy(package.json, app_dir, overwrite = TRUE)

  old_warn <- getOption("warn")
  options(warn = -1)
  info <- try(
    system2(
      npm_exec(),
      args = c("--prefix", shQuote(app_dir, type = "cmd"), "install"),
      stderr = TRUE, stdout = TRUE), silent = TRUE)
  options(warn = old_warn)
  out <- !1 %in% attr(info, "status")
  if(!out) {
    stop(paste0(info, collapse = "\n"))
  }

  index.js <- system.file(package = "cookimage", "compress-images", "index.js")
  file.copy(index.js, to = app_dir, overwrite = TRUE)
  invisible(NULL)
}