#' @title Key Missing Sentinel
#' @description \code{key_missing()} returns a sentinel object indicating
#'   that a requested key was not found in a cache. \code{is.key_missing()}
#'   tests whether a value is this sentinel. Mirrors
#'   \code{cachem::key_missing()} / \code{fastmap::key_missing()}.
#' @param x An object to test.
#' @return \code{key_missing()} returns an object of class
#'   \code{"key_missing"}. \code{is.key_missing()} returns \code{TRUE} or
#'   \code{FALSE}.
#' @rdname key_missing
#' @export
key_missing <- function() {
  structure(list(), class = "key_missing")
}

#' @rdname key_missing
#' @export
is.key_missing <- function(x) {
  inherits(x, "key_missing")
}

# Internal: validate a cache key, shared by mcache() and dcache().
validate_key <- function(key) {
  if (!is.character(key) || length(key) != 1L || is.na(key) || !nzchar(key)) {
    stop("`key` must be a single, non-missing, non-empty string.", call. = FALSE)
  }
}

#' @title Create a Memory Cache
#' @description A lightweight in-memory key-value cache. Values are stored
#'   directly in an environment (not serialized), so as long as an object is
#'   cached it will not be garbage collected.
#' @param max_size Maximum size of the cache, in bytes, as reported by
#'   \code{\link[utils]{object.size}}. Use \code{Inf} (the default) for no
#'   limit.
#' @param max_age Maximum age of an object, in seconds, before it is evicted.
#'   Use \code{Inf} (the default) for no limit.
#' @param max_n Maximum number of objects allowed in the cache. Use
#'   \code{Inf} (the default) for no limit.
#' @param evict Eviction policy used when \code{max_n} or \code{max_size} is
#'   exceeded: \code{"lru"} (least recently used, the default) or
#'   \code{"fifo"} (first in, first out).
#' @param missing Value returned by \code{get()} when \code{key} is not
#'   present in the cache. Defaults to a \code{\link{key_missing}}()
#'   sentinel; test for it with \code{\link{is.key_missing}}().
#' @return An \code{mcache} object with methods \code{get(key, missing)},
#'   \code{set(key, value)}, \code{exists(key)}, \code{remove(key)},
#'   \code{keys()}, \code{size()}, \code{reset()}, and \code{prune()}.
#' @examples
#' cache <- mcache()
#'
#' fit_model <- function(n, cache) {
#'   key <- hash(n)
#'   cached <- cache$get(key)
#'   if (!is.key_missing(cached)) {
#'     return(cached)
#'   }
#'
#'   set.seed(123)
#'   mydata <- data.frame(x = seq_len(n), y = seq_len(n) * 2 + rnorm(n))
#'   mycoef <- coef(lm(y ~ x, data = mydata))
#'
#'   cache$set(key, mycoef)
#'   mycoef
#' }
#'
#' fit_model(100, cache) # computed and cached
#' fit_model(100, cache) # reused from disk, no recomputation
#' @export
mcache <- function(max_size = Inf,
                    max_age = Inf,
                    max_n = Inf,
                    evict = c("lru", "fifo"),
                    missing = key_missing()) {
  if (!is.numeric(max_size)) stop("max_size must be a number. Use `Inf` for no limit.")
  if (!is.numeric(max_age))  stop("max_age must be a number. Use `Inf` for no limit.")
  if (!is.numeric(max_n))    stop("max_n must be a number. Use `Inf` for no limit.")
  evict <- match.arg(evict)
  missing_default <- missing

  store <- new.env(parent = emptyenv())  # key -> value
  mtime <- new.env(parent = emptyenv())  # key -> creation/write time
  atime <- new.env(parent = emptyenv())  # key -> last-access time
  osize <- new.env(parent = emptyenv())  # key -> object size in bytes

  evict_key <- function(key) {
    rm(list = key, envir = store)
    rm(list = key, envir = mtime)
    rm(list = key, envir = atime)
    rm(list = key, envir = osize)
  }

  evict_if_aged <- function(key) {
    if (is.finite(max_age) && base::exists(key, envir = store, inherits = FALSE)) {
      age <- as.numeric(Sys.time()) - base::get(key, envir = mtime, inherits = FALSE)
      if (age > max_age) evict_key(key)
    }
  }

  get <- function(key, missing = missing_default) {
    validate_key(key)
    evict_if_aged(key)
    if (!base::exists(key, envir = store, inherits = FALSE)) {
      return(missing)
    }
    assign(key, as.numeric(Sys.time()), envir = atime)
    base::get(key, envir = store, inherits = FALSE)
  }

  set <- function(key, value) {
    validate_key(key)
    now <- as.numeric(Sys.time())
    assign(key, value, envir = store)
    assign(key, now, envir = mtime)
    assign(key, now, envir = atime)
    assign(key, as.numeric(utils::object.size(value)), envir = osize)
    prune()
    invisible(TRUE)
  }

  exists <- function(key) {
    validate_key(key)
    evict_if_aged(key)
    base::exists(key, envir = store, inherits = FALSE)
  }

  remove <- function(key) {
    validate_key(key)
    if (base::exists(key, envir = store, inherits = FALSE)) evict_key(key)
    invisible(TRUE)
  }

  keys <- function() {
    ls(store)
  }

  size <- function() {
    length(ls(store))
  }

  reset <- function() {
    for (k in ls(store)) evict_key(k)
    invisible(TRUE)
  }

  prune <- function() {
    ks <- ls(store)
    if (length(ks) == 0L) return(invisible(TRUE))

    if (is.finite(max_age)) {
      now  <- as.numeric(Sys.time())
      aged <- Filter(function(k) (now - base::get(k, envir = mtime, inherits = FALSE)) > max_age, ks)
      for (k in aged) evict_key(k)
      ks <- ls(store)
    }

    time_env <- if (evict == "lru") atime else mtime

    if (is.finite(max_n) && length(ks) > max_n) {
      times <- vapply(ks, function(k) base::get(k, envir = time_env, inherits = FALSE), numeric(1))
      drop  <- ks[order(times)][seq_len(length(ks) - max_n)]
      for (k in drop) evict_key(k)
      ks <- ls(store)
    }

    if (is.finite(max_size) && length(ks) > 0L) {
      sizes <- vapply(ks, function(k) base::get(k, envir = osize, inherits = FALSE), numeric(1))
      if (sum(sizes) > max_size) {
        times    <- vapply(ks, function(k) base::get(k, envir = time_env, inherits = FALSE), numeric(1))
        ord      <- order(times, decreasing = TRUE)  # newest/most-recently-used first
        keep_cum <- cumsum(sizes[ord])
        drop     <- ks[ord][keep_cum > max_size]
        for (k in drop) evict_key(k)
      }
    }

    invisible(TRUE)
  }

  structure(
    list(
      get    = get,
      set    = set,
      exists = exists,
      remove = remove,
      keys   = keys,
      size   = size,
      reset  = reset,
      prune  = prune
    ),
    class = "mcache"
  )
}

#' @title Create a Disk Cache
#' @description A lightweight disk-backed key-value cache: each value is
#'   stored as its own \code{.rds} file inside \code{dir}. Pruning is not
#'   throttled, and eviction metadata (age, last-access time) comes directly
#'   from the files' own modification times rather than being tracked
#'   separately.
#' @param dir Directory used to store the cached files. If \code{NULL} (the
#'   default), a new temporary directory is created and used.
#' @param max_size,max_age,max_n,evict,missing See \code{\link{mcache}}.
#' @param destroy_on_finalize If \code{TRUE}, the cache directory and all of
#'   its contents are deleted from disk when the returned object is garbage
#'   collected. Default \code{FALSE}.
#' @return A \code{dcache} object with the same methods as
#'   \code{\link{mcache}}, plus \code{destroy()}, which deletes the cache
#'   directory from disk.
#' @examples
#' cache <- dcache(dir = tempdir())
#'
#' fit_model <- function(n, cache) {
#'   key <- hash(n)
#'   cached <- cache$get(key)
#'   if (!is.key_missing(cached)) {
#'     return(cached)
#'   }
#'
#'   set.seed(123)
#'   mydata <- data.frame(x = seq_len(n), y = seq_len(n) * 2 + rnorm(n))
#'   mycoef <- coef(lm(y ~ x, data = mydata))
#'
#'   cache$set(key, mycoef)
#'   mycoef
#' }
#'
#' fit_model(100, cache) # computed and cached
#' fit_model(100, cache) # reused from disk, no recomputation
#' @export
dcache <- function(dir = NULL,
                    max_size = Inf,
                    max_age = Inf,
                    max_n = Inf,
                    evict = c("lru", "fifo"),
                    missing = key_missing(),
                    destroy_on_finalize = FALSE) {
  if (!is.numeric(max_size)) stop("max_size must be a number. Use `Inf` for no limit.")
  if (!is.numeric(max_age))  stop("max_age must be a number. Use `Inf` for no limit.")
  if (!is.numeric(max_n))    stop("max_n must be a number. Use `Inf` for no limit.")
  evict <- match.arg(evict)
  missing_default <- missing

  if (is.null(dir)) dir <- tempfile("dcache-")
  if (!dir.exists(dir)) dir.create(dir, recursive = TRUE)
  dir <- normalizePath(dir)
  destroyed <- FALSE

  key_to_file <- function(key) file.path(dir, paste0(key, ".rds"))

  check_alive <- function() {
    if (destroyed) {
      stop("Attempted to use cache which has already been destroyed.", call. = FALSE)
    }
  }

  evict_if_aged <- function(key) {
    if (!is.finite(max_age)) return(invisible())
    f <- key_to_file(key)
    if (file.exists(f) && (as.numeric(Sys.time()) - as.numeric(file.mtime(f))) > max_age) {
      file.remove(f)
    }
  }

  get <- function(key, missing = missing_default) {
    check_alive()
    validate_key(key)
    evict_if_aged(key)
    f <- key_to_file(key)
    if (!file.exists(f)) return(missing)
    value <- readRDS(f)
    if (evict == "lru") Sys.setFileTime(f, Sys.time())
    value
  }

  set <- function(key, value) {
    check_alive()
    validate_key(key)
    saveRDS(value, key_to_file(key))
    prune()
    invisible(TRUE)
  }

  exists <- function(key) {
    check_alive()
    validate_key(key)
    evict_if_aged(key)
    file.exists(key_to_file(key))
  }

  remove <- function(key) {
    check_alive()
    validate_key(key)
    f <- key_to_file(key)
    if (file.exists(f)) file.remove(f)
    invisible(TRUE)
  }

  cache_files <- function() {
    list.files(dir, pattern = "\\.rds$", full.names = TRUE)
  }

  keys <- function() {
    check_alive()
    sub("\\.rds$", "", basename(cache_files()))
  }

  size <- function() {
    check_alive()
    length(cache_files())
  }

  reset <- function() {
    check_alive()
    files <- cache_files()
    if (length(files) > 0L) file.remove(files)
    invisible(TRUE)
  }

  prune <- function() {
    check_alive()
    files <- cache_files()
    if (length(files) == 0L) return(invisible(TRUE))

    file_times <- function(fs) {
      if (evict == "lru") as.numeric(file.info(fs)$atime) else as.numeric(file.mtime(fs))
    }

    if (is.finite(max_age)) {
      mtimes <- as.numeric(file.mtime(files))
      aged   <- files[(as.numeric(Sys.time()) - mtimes) > max_age]
      if (length(aged) > 0L) file.remove(aged)
      files <- cache_files()
    }

    if (length(files) == 0L) return(invisible(TRUE))

    if (is.finite(max_n) && length(files) > max_n) {
      times <- file_times(files)
      drop  <- files[order(times)][seq_len(length(files) - max_n)]
      file.remove(drop)
      files <- cache_files()
    }

    if (is.finite(max_size) && length(files) > 0L) {
      sizes <- file.info(files)$size
      if (sum(sizes) > max_size) {
        times    <- file_times(files)
        ord      <- order(times, decreasing = TRUE)  # newest/most-recently-used first
        keep_cum <- cumsum(sizes[ord])
        drop     <- files[ord][keep_cum > max_size]
        if (length(drop) > 0L) file.remove(drop)
      }
    }

    invisible(TRUE)
  }

  destroy <- function() {
    if (destroyed) return(invisible(TRUE))
    unlink(dir, recursive = TRUE)
    destroyed <<- TRUE
    invisible(TRUE)
  }

  if (destroy_on_finalize) {
    reg.finalizer(environment(), function(e) e$destroy())
  }

  structure(
    list(
      get     = get,
      set     = set,
      exists  = exists,
      remove  = remove,
      keys    = keys,
      size    = size,
      reset   = reset,
      prune   = prune,
      destroy = destroy
    ),
    class = "dcache"
  )
}
