###########################################################
## Functions for caching
###########################################################

.createHash <- function(
  mart,
  attributes,
  filters,
  values,
  uniqueRows = TRUE,
  bmHeader = FALSE
) {
  ## if we are using the current version Ensembl URL
  ## swap for the archive version so we can check when it is outdated
  host <- martHost(mart)
  if (grepl("(www|useast|asia)\\.ensembl\\.org", host)) {
    archives <- .listEnsemblArchives(http_config = martHTTPConfig(mart))
    host <- archives[which(archives$current_release == "*"), "url"]
  }

  attributes <- paste(sort(attributes), collapse = "")
  ## need to keep the filters and values in the same order
  ## so create a single index for reordering both
  idx <- order(filters)
  filters <- paste(filters[idx], collapse = "")
  if (is.list(values)) {
    values <- values[idx]
    values <- unlist(lapply(values, sort))
  } else {
    values <- sort(values)
  }
  values <- paste(values, collapse = "")

  combined <- paste(
    c(
      host,
      mart@biomart,
      mart@dataset,
      attributes,
      filters,
      values,
      uniqueRows,
      bmHeader
    ),
    collapse = "_"
  )
  paste0("biomaRt_", tools::md5sum(bytes = charToRaw(combined)))
}

#' @param bfc Object of class BiocFileCache, created by a call to
#' [BiocFileCache::BiocFileCache()]
#' @param hash unique hash representing a query.
#' @importFrom BiocFileCache bfcadd bfcquery bfcupdate
#' @noRd
.addToCache <- function(bfc, result, hash, update = FALSE) {
  if (!dir.exists(.biomartCacheLocation())) {
    dir.create(.biomartCacheLocation())
  }

  ## write our file to the biomart cache location directly
  tf <- tempfile(tmpdir = .biomartCacheLocation())
  saveRDS(result, file = tf)

  ## check once more that there isn't an entry with this hash
  ## if its free add our new file
  ## if there's a clash don't add anything and tidy up
  if (!.checkInCache(bfc, hash = hash)) {
    bfcadd(bfc, rname = hash, fpath = tf, action = "asis")
    return(invisible(TRUE))
  }
  if (!update) {
    file.remove(tf)
    return(invisible(FALSE))
  }
  existing_record <- bfcquery(
    bfc,
    query = hash,
    field = "rname",
    exact = TRUE
  )
  bfcupdate(bfc, rids = existing_record$rid, rpath = tf, ask = FALSE)
  ## deleted the old file
  file.remove(existing_record$rpath)

  return(invisible(TRUE))
}

#' @param bfc Object of class BiocFileCache, created by a call to
#'   [BiocFileCache::BiocFileCache()]
#' @param hash unique hash representing a query.
#' @noRd
#' @importFrom BiocFileCache bfcquery
.readFromCache <- function(bfc, hash) {
  cache_hits <- bfcquery(bfc, hash, field = "rname")
  if (nrow(cache_hits) > 1) {
    stop(
      "Multiple cache results found.",
      "\nPlease clear your cache by running biomartCacheClear()"
    )
  } else {
    rid <- cache_hits$rid
    result <- readRDS(bfc[[rid]])
    return(result)
  }
}

#' @param bfc Object of class BiocFileCache, created by a call to
#'   [BiocFileCache::BiocFileCache()]
#' @param hash unique hash representing a query.
#'
#' This function returns `TRUE` if a record with the requested hash already
#' exists in the file cache, otherwise returns `FALSE`.
#' @keywords Internal
#' @noRd
#' @importFrom BiocFileCache bfcquery
.checkInCache <- function(bfc, hash, verbose = FALSE) {
  res <- bfcquery(bfc, query = hash, field = "rname")
  as.logical(nrow(res))
}

#' @param bfc Object of class BiocFileCache, created by a call to
#' [BiocFileCache::BiocFileCache()]
#' @param hash unique hash representing a query.
#'
#' This function checks if a cache entry is a valid RDS file.
#' Returns `TRUE` if the cache entry is valid, `FALSE` otherwise.
#' In the case of an invalid file the cache entry and file are
#' deleted.
#' @importFrom BiocFileCache bfcquery bfcremove
#' @keywords Internal
#' @noRd
.checkValidCache <- function(bfc, hash) {
  res <- bfcquery(bfc, query = hash, field = "rname")
  if (nrow(res) == 0) {
    return(FALSE)
  } else {
    ## check this is a valid RDS file
    ## remove the cache entry if it's not a valid RDS
    test <- tryCatch(is.list(infoRDS(res$rpath[1])), error = function(e) {
      return(FALSE)
    })
    if (!test) {
      bfcremove(bfc, res$rid[1])
    }
    return(test)
  }
}

.biomartCacheLocation <- function() {
  Sys.getenv(
    x = "BIOMART_CACHE",
    unset = tools::R_user_dir(package = "biomaRt", which = "cache")
  )
}

#' \pkg{biomaRt} result caching
#'
#' \pkg{biomaRt} makes use of a results cache to speedup execution of queries
#' that have been run before. These functions provide details on the status of
#' this cache, and allow it to be deleted.
#'
#'
#' @aliases biomartCacheInfo biomartCacheClear
#' @return These functions do not return anything and are called for their side
#' effects. [biomartCacheInfo()] prints the location of the cache, along
#' with the number of files and their total size on disk.
#' [biomartCacheClear()] will delete the current contents of the cache.
#' @author Mike Smith
#' @keywords IO
#'
#' @name biomartCache
#' @importFrom BiocFileCache removebfc
#' @export
biomartCacheClear <- function() {
  cache <- .biomartCacheLocation()
  bfc <- BiocFileCache::BiocFileCache(cache, ask = FALSE)
  removebfc(bfc, ask = FALSE)
}

#' @rdname biomartCache
#' @importFrom BiocFileCache bfcinfo
#' @export
biomartCacheInfo <- function() {
  cache <- .biomartCacheLocation()

  if (file.exists(cache)) {
    bfc <- BiocFileCache::BiocFileCache(cache, ask = FALSE)
    files <- bfcinfo(bfc)$rpath
    total_size <- sum(file.size(files))
    size_obj <- structure(total_size, class = "object_size")

    message(
      "biomaRt cache\n",
      "- Location: ",
      cache,
      "\n",
      "- No. of files: ",
      length(files),
      "\n",
      "- Total size: ",
      format(size_obj, units = "auto")
    )
  } else {
    message("biomaRt cache uninitialized\n", "- Location: ", cache)
  }
  return(invisible(cache))
}

#' Determine if a cached version exists and if it's less than one week old.
#'
#' @param bfc BiocFileCache object created by [BiocFileCache()]
#' @param cacheEntry The name of entry in the cache.
#' @param numDays The number of days an entry should be considered valid. Entries
#' older than this will be deleted.
#' @keywords Internal
#' @noRd
#' @importFrom BiocFileCache bfcquery bfcremove
.useCache <- function(bfc, cacheEntry, numDays = 7L) {
  use_cached_version <- FALSE
  if (.checkInCache(bfc, hash = cacheEntry)) {
    cache_entry <- bfcquery(x = bfc, query = cacheEntry)
    is_outdated <- Sys.Date() - as.Date(cache_entry$create_time) >= numDays
    if (nrow(cache_entry) == 1 && !is_outdated) {
      use_cached_version <- TRUE
    } else {
      bfcremove(bfc, cache_entry$rid)
    }
  }
  return(use_cached_version)
}
