R/cache.R

In writeAlizer: Generate Predicted Writing Quality Scores

#' Path to writeAlizer's user cache
#'
#' Returns the directory used to store cached model artifacts. By default this is
#' a platform-appropriate user cache path from \code{tools::R_user_dir("writeAlizer","cache")}.
#' If the option \code{writeAlizer.cache_dir} is set to a non-empty string, that
#' location is used instead. This makes it easy to redirect the cache during tests
#' or examples (e.g., to \code{tempdir()}).
#'
#' The override must be one non-missing character string. An empty string uses
#' the default. Choose a dedicated directory: clearing the cache deletes all of
#' its contents.
#' @return Character scalar path.
#' @seealso \code{\link{wa_cache_clear}}
#' @examples
#' wa_cache_dir()  # Inspect the path without creating or deleting files
#' @export
wa_cache_dir <- function() {
  override <- .wa_path_option("writeAlizer.cache_dir")
  if (!is.null(override)) return(override)
  tools::R_user_dir("writeAlizer", "cache")
}

# Empty options mean "use the default"; malformed options must not reach file I/O.
.wa_path_option <- function(name) {
  value <- getOption(name)
  if (is.null(value)) return(NULL)
  if (!is.character(value) || length(value) != 1L || is.na(value)) {
    rlang::abort(paste0("Option `", name, "` must be a single path or NULL."),
                 .subclass = "writeAlizer_input_error")
  }
  if (!nzchar(value)) return(NULL)
  path.expand(value)
}

# --- internal test hooks (not exported) ---------------------------------------
# These let tests drive interactive/confirm/unlink branches deterministically
# without patching base functions or prompting users.

.wa_is_interactive <- function() {
  opt <- getOption("writeAlizer.force_interactive", NULL)
  if (!is.null(opt)) return(isTRUE(opt))
  interactive()
}

.wa_menu <- function(choices, title = NULL) {
  fn <- getOption("writeAlizer.menu_fn", utils::menu)
  fn(choices, title = title)
}

.wa_unlink <- function(path, recursive = FALSE, force = FALSE) {
  fn <- getOption("writeAlizer.unlink_fn", unlink)
  fn(path, recursive = recursive, force = force)
}

# Internal: build a full cache file path for a given filename.
# Used by the artifact loader when present.
#' @keywords internal
#' @noRd
.wa_cached_path <- function(filename) file.path(wa_cache_dir(), filename)

#' Clear writeAlizer's user cache
#'
#' Deletes all files under \code{wa_cache_dir()}. If \code{ask = TRUE} \emph{and} in an
#' interactive session, a short preview (item count, total size, and up to 10 sample
#' paths) is printed before asking for confirmation. In a non-interactive script,
#' no prompt is shown, even if \code{ask = TRUE}. Use this only on a dedicated
#' cache folder; all its contents are removed.
#'
#' @param ask Logical; if \code{TRUE} and interactive, ask for confirmation.
#' @param preview Logical; if \code{TRUE} and \code{ask} is \code{TRUE}, show a brief
#'   listing/size summary before asking.
#' @return Invisibly returns \code{TRUE} if the cache was cleared (or already absent),
#'   \code{FALSE} if the user declined or deletion failed.
#' @seealso \code{\link{wa_cache_dir}}
#' @examples
#' local({
#'   old <- options(writeAlizer.cache_dir = tempfile("wa-cache-"))
#'   on.exit(options(old))
#'   dir.create(wa_cache_dir())
#'   on.exit(unlink(wa_cache_dir(), recursive = TRUE), add = TRUE, after = FALSE)
#'   writeLines("demo", file.path(wa_cache_dir(), "demo.txt"))
#'   wa_cache_clear(ask = FALSE)
#' })
#' @export
wa_cache_clear <- function(ask = interactive(), preview = TRUE) {
  if (!is.logical(ask) || length(ask) != 1L || is.na(ask) ||
      !is.logical(preview) || length(preview) != 1L || is.na(preview)) {
    rlang::abort("`ask` and `preview` must each be TRUE or FALSE.",
                 .subclass = "writeAlizer_input_error")
  }
  path <- wa_cache_dir()
  if (!dir.exists(path)) {
    message("Cache directory does not exist: ", path)
    return(invisible(TRUE))
  }

  # Preview
  if (isTRUE(ask) && .wa_is_interactive() && isTRUE(preview)) {
    files <- list.files(path, all.files = TRUE, full.names = TRUE,
                        recursive = TRUE, include.dirs = TRUE, no.. = TRUE)
    n <- length(files)
    sizes <- tryCatch({
      info <- file.info(files)
      sum(info$size[!info$isdir], na.rm = TRUE)
    }, error = function(e) NA_real_)
    fmt_size <- function(b) {
      if (is.na(b)) return("unknown")
      units <- c("B","KB","MB","GB","TB")
      if (b <= 0) return("0 B")
      i <- floor(log(b, 1024)); i <- max(0, min(i, length(units)-1))
      sprintf("%.1f %s", b / (1024^i), units[i+1])
    }
    message("About to delete ", n, " item", if (n != 1) "s" else "", " (", fmt_size(sizes), ") under:\n  ", path)
    if (n) {
      preview_n <- min(10L, n)
      message("Preview (first ", preview_n, "):\n  ", paste(files[seq_len(preview_n)], collapse = "\n  "))
    }
  }

  proceed <- TRUE
  if (isTRUE(ask) && .wa_is_interactive()) {
    ans <- .wa_menu(c("No", "Yes"),
                    title = paste0("Delete ALL files under\n  ", path, "\n?"))
    proceed <- identical(ans, 2L)
  }
  if (!proceed) return(invisible(FALSE))

  ok <- .wa_unlink(path, recursive = TRUE, force = TRUE) == 0
  if (ok) {
    message("Cleared cache: ", path)
    # Re-create empty directory so downstream code expecting it won't fail
    dir.create(path, recursive = TRUE, showWarnings = FALSE)
  } else {
    warning("Failed to clear: ", path)
  }
  invisible(ok)
}