diff --git a/.github/workflows/R-CMD-check.yaml b/.github/workflows/R-CMD-check.yaml index a3ac618..74d8c97 100644 --- a/.github/workflows/R-CMD-check.yaml +++ b/.github/workflows/R-CMD-check.yaml @@ -29,7 +29,7 @@ jobs: R_KEEP_PKG_SOURCE: yes steps: - - uses: actions/checkout@v3 + - uses: actions/checkout@v4 - uses: r-lib/actions/setup-pandoc@v2 diff --git a/DESCRIPTION b/DESCRIPTION index 2fc1831..b35e46b 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -17,9 +17,10 @@ Suggests: testthat (>= 3.0.0), redux (>= 1.1.0), RPostgres, + RSQLite, withr Config/testthat/edition: 3 Encoding: UTF-8 LazyData: true Roxygen: list(markdown = TRUE) -RoxygenNote: 7.2.3 +RoxygenNote: 7.3.3 diff --git a/NAMESPACE b/NAMESPACE index 485406f..0ed8571 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -3,6 +3,7 @@ export(cache_mongo) export(cache_postgres) export(cache_redis) +export(cache_sqlite) importFrom(R6,R6Class) importFrom(attempt,stop_if_not) importFrom(digest,digest) diff --git a/R/sqlite.R b/R/sqlite.R new file mode 100644 index 0000000..3c806b1 --- /dev/null +++ b/R/sqlite.R @@ -0,0 +1,184 @@ +#' A caching object backed by SQLite +#' +#' Create a cache backend stored in a SQLite database. This is the most +#' lightweight SQL-backed cache offered by `{bank}` — it only needs `{DBI}` +#' and `{RSQLite}` and supports an in-memory database (`dbname = ":memory:"`), +#' which makes it ideal for unit tests and short-lived sessions (#1). +#' +#' @export +#' @importFrom R6 R6Class +#' @importFrom digest digest +cache_sqlite <- R6::R6Class( + "cache_sqlite", + public = list( + #' @description Start a new SQLite cache. + #' @param dbname path to the SQLite file, or `":memory:"` for an + #' in-memory database (default). + #' @param ... additional arguments passed to + #' `DBI::dbConnect(RSQLite::SQLite(), dbname = dbname, ...)`. + #' @param cache_table name of the SQLite table backing the cache. + #' Defaults to `"bankrcache"`. + #' @param algo for `{memoise}` compatibility, the `digest()` algorithm. + #' @param compress for `{memoise}` compatibility, should the data be + #' compressed? + #' @return A `cache_sqlite` object. + initialize = function(dbname = ":memory:", + ..., + cache_table = "bankrcache", + algo = "sha512", + compress = FALSE) { + if (!requireNamespace("RSQLite", quietly = TRUE)) { + stop( + "The {RSQLite} package has to be installed before using `cache_sqlite`.\n", + "Please install it first, for example with install.packages('RSQLite')." + ) + } + if (!requireNamespace("DBI", quietly = TRUE)) { + stop( + "The {DBI} package has to be installed before using `cache_sqlite`.\n", + "Please install it first, for example with install.packages('DBI')." + ) + } + + private$interface <- DBI::dbConnect( + RSQLite::SQLite(), + dbname = dbname, + ... + ) + + private$cache_table <- cache_table + + if (cache_table %in% DBI::dbListTables(private$interface)) { + # Reusing an existing table: validate that the schema matches what + # cache_sqlite expects. Bail out early with a readable error rather + # than failing later inside an INSERT/SELECT. + cols <- DBI::dbListFields(private$interface, cache_table) + if (!setequal(cols, c("id", "cache"))) { + stop( + "Existing table `", cache_table, "` does not match the cache schema.", + "\nExpected columns: id, cache. Found: ", + paste(cols, collapse = ", "), + call. = FALSE + ) + } + } else { + DBI::dbCreateTable( + private$interface, + cache_table, + fields = c( + id = "TEXT", + cache = "BLOB" + ) + ) + } + + private$algo <- algo + private$compress <- compress + }, + #' @description Does the cache contain a given key? + #' @param key key name. + #' @return `TRUE`/`FALSE`. + has_key = function(key) { + res <- DBI::dbGetQuery( + private$interface, + sprintf("SELECT id FROM %s WHERE id = ?;", private$cache_table), + params = list(key) + ) + if (nrow(res) > 1L) { + stop("Corrupted cache: more than one entry for ", key) + } + nrow(res) == 1L + }, + #' @description Get a key from the cache. + #' @param key key name. + #' @return the value stored under `key`, or an object of class + #' `"key_missing"` if the key is absent. + get = function(key) { + if (!self$has_key(key)) { + return(structure(list(), class = "key_missing")) + } + out <- DBI::dbGetQuery( + private$interface, + sprintf("SELECT cache FROM %s WHERE id = ?;", private$cache_table), + params = list(key) + ) + tryCatch( + unserialize(out$cache[[1L]]), + error = function(e) structure(list(), class = "key_missing") + ) + }, + #' @description Set a key in the cache. If the key already exists, its + #' value is overwritten (matching the {memoise} cache contract). + #' @param key key name. + #' @param value value to store. + #' @return used for side effect. + set = function(key, value) { + blob <- serialize(value, NULL) + if (self$has_key(key)) { + DBI::dbExecute( + private$interface, + sprintf( + "UPDATE %s SET cache = ? WHERE id = ?;", + private$cache_table + ), + params = list(list(blob), key) + ) + } else { + DBI::dbExecute( + private$interface, + sprintf( + "INSERT INTO %s (id, cache) VALUES (?, ?);", + private$cache_table + ), + params = list(key, list(blob)) + ) + } + invisible(NULL) + }, + #' @description Clear the whole cache. + #' @return used for side effect. + reset = function() { + DBI::dbExecute( + private$interface, + sprintf("DELETE FROM %s;", private$cache_table) + ) + invisible(NULL) + }, + #' @description Remove a single key. + #' @param key key name. + #' @return number of rows removed. + remove = function(key) { + DBI::dbExecute( + private$interface, + sprintf("DELETE FROM %s WHERE id = ?;", private$cache_table), + params = list(key) + ) + }, + #' @description List every key in the cache. + #' @return a character vector of keys. + keys = function() { + DBI::dbGetQuery( + private$interface, + sprintf("SELECT id FROM %s;", private$cache_table) + )$id + }, + #' @description Hash helper for `{memoise}` compatibility. + #' @param ... value to hash. + #' @return a character(1) hash. + digest = function(...) digest::digest(..., algo = private$algo) + ), + private = list( + interface = NULL, + cache_table = character(0), + algo = character(0), + compress = logical(0), + finalize = function() { + if (!is.null(private$interface) && + inherits(private$interface, "DBIConnection") && + DBI::dbIsValid(private$interface)) { + DBI::dbDisconnect(private$interface) + } + invisible(NULL) + } + ) +) diff --git a/man/cache_sqlite.Rd b/man/cache_sqlite.Rd new file mode 100644 index 0000000..0e7e378 --- /dev/null +++ b/man/cache_sqlite.Rd @@ -0,0 +1,216 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/sqlite.R +\name{cache_sqlite} +\alias{cache_sqlite} +\title{A caching object backed by SQLite} +\description{ +A caching object backed by SQLite + +A caching object backed by SQLite +} +\details{ +Create a cache backend stored in a SQLite database. This is the most +lightweight SQL-backed cache offered by \code{{bank}} — it only needs \code{{DBI}} +and \code{{RSQLite}} and supports an in-memory database (\code{dbname = ":memory:"}), +which makes it ideal for unit tests and short-lived sessions (#1). +} +\section{Methods}{ +\subsection{Public methods}{ +\itemize{ +\item \href{#method-cache_sqlite-new}{\code{cache_sqlite$new()}} +\item \href{#method-cache_sqlite-has_key}{\code{cache_sqlite$has_key()}} +\item \href{#method-cache_sqlite-get}{\code{cache_sqlite$get()}} +\item \href{#method-cache_sqlite-set}{\code{cache_sqlite$set()}} +\item \href{#method-cache_sqlite-reset}{\code{cache_sqlite$reset()}} +\item \href{#method-cache_sqlite-remove}{\code{cache_sqlite$remove()}} +\item \href{#method-cache_sqlite-keys}{\code{cache_sqlite$keys()}} +\item \href{#method-cache_sqlite-digest}{\code{cache_sqlite$digest()}} +\item \href{#method-cache_sqlite-clone}{\code{cache_sqlite$clone()}} +} +} +\if{html}{\out{
}} +\if{html}{\out{}} +\if{latex}{\out{\hypertarget{method-cache_sqlite-new}{}}} +\subsection{Method \code{new()}}{ +Start a new SQLite cache. +\subsection{Usage}{ +\if{html}{\out{
}}\preformatted{cache_sqlite$new( + dbname = ":memory:", + ..., + cache_table = "bankrcache", + algo = "sha512", + compress = FALSE +)}\if{html}{\out{
}} +} + +\subsection{Arguments}{ +\if{html}{\out{
}} +\describe{ +\item{\code{dbname}}{path to the SQLite file, or \code{":memory:"} for an +in-memory database (default).} + +\item{\code{...}}{additional arguments passed to +\code{DBI::dbConnect(RSQLite::SQLite(), dbname = dbname, ...)}.} + +\item{\code{cache_table}}{name of the SQLite table backing the cache. +Defaults to \code{"bankrcache"}.} + +\item{\code{algo}}{for \code{{memoise}} compatibility, the \code{digest()} algorithm.} + +\item{\code{compress}}{for \code{{memoise}} compatibility, should the data be +compressed?} +} +\if{html}{\out{
}} +} +\subsection{Returns}{ +A \code{cache_sqlite} object. +} +} +\if{html}{\out{
}} +\if{html}{\out{}} +\if{latex}{\out{\hypertarget{method-cache_sqlite-has_key}{}}} +\subsection{Method \code{has_key()}}{ +Does the cache contain a given key? +\subsection{Usage}{ +\if{html}{\out{
}}\preformatted{cache_sqlite$has_key(key)}\if{html}{\out{
}} +} + +\subsection{Arguments}{ +\if{html}{\out{
}} +\describe{ +\item{\code{key}}{key name.} +} +\if{html}{\out{
}} +} +\subsection{Returns}{ +\code{TRUE}/\code{FALSE}. +} +} +\if{html}{\out{
}} +\if{html}{\out{}} +\if{latex}{\out{\hypertarget{method-cache_sqlite-get}{}}} +\subsection{Method \code{get()}}{ +Get a key from the cache. +\subsection{Usage}{ +\if{html}{\out{
}}\preformatted{cache_sqlite$get(key)}\if{html}{\out{
}} +} + +\subsection{Arguments}{ +\if{html}{\out{
}} +\describe{ +\item{\code{key}}{key name.} +} +\if{html}{\out{
}} +} +\subsection{Returns}{ +the value stored under \code{key}, or an object of class +\code{"key_missing"} if the key is absent. +} +} +\if{html}{\out{
}} +\if{html}{\out{}} +\if{latex}{\out{\hypertarget{method-cache_sqlite-set}{}}} +\subsection{Method \code{set()}}{ +Set a key in the cache. If the key already exists, its +value is overwritten (matching the {memoise} cache contract). +\subsection{Usage}{ +\if{html}{\out{
}}\preformatted{cache_sqlite$set(key, value)}\if{html}{\out{
}} +} + +\subsection{Arguments}{ +\if{html}{\out{
}} +\describe{ +\item{\code{key}}{key name.} + +\item{\code{value}}{value to store.} +} +\if{html}{\out{
}} +} +\subsection{Returns}{ +used for side effect. +} +} +\if{html}{\out{
}} +\if{html}{\out{}} +\if{latex}{\out{\hypertarget{method-cache_sqlite-reset}{}}} +\subsection{Method \code{reset()}}{ +Clear the whole cache. +\subsection{Usage}{ +\if{html}{\out{
}}\preformatted{cache_sqlite$reset()}\if{html}{\out{
}} +} + +\subsection{Returns}{ +used for side effect. +} +} +\if{html}{\out{
}} +\if{html}{\out{}} +\if{latex}{\out{\hypertarget{method-cache_sqlite-remove}{}}} +\subsection{Method \code{remove()}}{ +Remove a single key. +\subsection{Usage}{ +\if{html}{\out{
}}\preformatted{cache_sqlite$remove(key)}\if{html}{\out{
}} +} + +\subsection{Arguments}{ +\if{html}{\out{
}} +\describe{ +\item{\code{key}}{key name.} +} +\if{html}{\out{
}} +} +\subsection{Returns}{ +number of rows removed. +} +} +\if{html}{\out{
}} +\if{html}{\out{}} +\if{latex}{\out{\hypertarget{method-cache_sqlite-keys}{}}} +\subsection{Method \code{keys()}}{ +List every key in the cache. +\subsection{Usage}{ +\if{html}{\out{
}}\preformatted{cache_sqlite$keys()}\if{html}{\out{
}} +} + +\subsection{Returns}{ +a character vector of keys. +} +} +\if{html}{\out{
}} +\if{html}{\out{}} +\if{latex}{\out{\hypertarget{method-cache_sqlite-digest}{}}} +\subsection{Method \code{digest()}}{ +Hash helper for \code{{memoise}} compatibility. +\subsection{Usage}{ +\if{html}{\out{
}}\preformatted{cache_sqlite$digest(...)}\if{html}{\out{
}} +} + +\subsection{Arguments}{ +\if{html}{\out{
}} +\describe{ +\item{\code{...}}{value to hash.} +} +\if{html}{\out{
}} +} +\subsection{Returns}{ +a character(1) hash. +} +} +\if{html}{\out{
}} +\if{html}{\out{}} +\if{latex}{\out{\hypertarget{method-cache_sqlite-clone}{}}} +\subsection{Method \code{clone()}}{ +The objects of this class are cloneable with this method. +\subsection{Usage}{ +\if{html}{\out{
}}\preformatted{cache_sqlite$clone(deep = FALSE)}\if{html}{\out{
}} +} + +\subsection{Arguments}{ +\if{html}{\out{
}} +\describe{ +\item{\code{deep}}{Whether to make a deep clone.} +} +\if{html}{\out{
}} +} +} +} diff --git a/tests/testthat/helpers-utils.R b/tests/testthat/helpers-utils.R index d7770d6..6e76678 100644 --- a/tests/testthat/helpers-utils.R +++ b/tests/testthat/helpers-utils.R @@ -54,18 +54,24 @@ test_them_all <- function(cache_obj) { ) } -if (!requireNamespace("redux", quietly = TRUE)) { - install.packages("redux") -} -if (!requireNamespace("mongolite", quietly = TRUE)) { - install.packages("mongolite") -} -if (!requireNamespace("DBI", quietly = TRUE)) { - install.packages("DBI") -} -if (!requireNamespace("RPostgres", quietly = TRUE)) { - install.packages("RPostgres") +# Optional backend deps. They are only useful for the docker-backed +# integration tests (Redis / Mongo / Postgres). Failure to install them +# (e.g. on a sandbox without a compiler or repo access) must not crash the +# whole test run — cache_sqlite is a pure-R backend that needs none of +# them, and individual tests already skip_if_not_installed(). +maybe_install <- function(pkg) { + if (!requireNamespace(pkg, quietly = TRUE)) { + tryCatch( + install.packages(pkg), + error = function(e) message("Could not install ", pkg, ": ", conditionMessage(e)), + warning = function(w) message("Could not install ", pkg, ": ", conditionMessage(w)) + ) + } } +maybe_install("redux") +maybe_install("mongolite") +maybe_install("DBI") +maybe_install("RPostgres") withr::defer( { diff --git a/tests/testthat/test-mongo.R b/tests/testthat/test-mongo.R index 9a0565b..c999b6d 100644 --- a/tests/testthat/test-mongo.R +++ b/tests/testthat/test-mongo.R @@ -1,5 +1,7 @@ test_that("cache_redis works", { skip_on_ci() + skip_if_not_installed("mongolite") + if (Sys.which("docker") == "") skip("docker not available") system("docker run --rm --name mongobankunittest -d -p 27066:27017 -e MONGO_INITDB_ROOT_USERNAME=bebop -e MONGO_INITDB_ROOT_PASSWORD=aloula mongo:4") Sys.sleep(10) diff --git a/tests/testthat/test-postgres.R b/tests/testthat/test-postgres.R index 51751f9..3cd6456 100644 --- a/tests/testthat/test-postgres.R +++ b/tests/testthat/test-postgres.R @@ -1,5 +1,8 @@ test_that("cache_postgres works", { skip_on_ci() + skip_if_not_installed("RPostgres") + skip_if_not_installed("DBI") + if (Sys.which("docker") == "") skip("docker not available") system("docker run --rm --name postgresbankunittest -e POSTGRES_PASSWORD=mysecretpassword -d -p 5434:5432 postgres") Sys.sleep(10) diff --git a/tests/testthat/test-redis.R b/tests/testthat/test-redis.R index aec1d67..6d0fbdc 100644 --- a/tests/testthat/test-redis.R +++ b/tests/testthat/test-redis.R @@ -1,5 +1,7 @@ test_that("cache_redis works", { skip_on_ci() + skip_if_not_installed("redux") + if (Sys.which("docker") == "") skip("docker not available") system("docker run --rm --name redisbankunittest -d -p 6379:6379 redis:5.0.5 --requirepass bebopalula") Sys.sleep(10) diff --git a/tests/testthat/test-sqlite.R b/tests/testthat/test-sqlite.R new file mode 100644 index 0000000..e99fd75 --- /dev/null +++ b/tests/testthat/test-sqlite.R @@ -0,0 +1,83 @@ +test_that("cache_sqlite works end-to-end in-memory", { + skip_if_not_installed("RSQLite") + skip_if_not_installed("memoise") + + sqlite_cache <- cache_sqlite$new(dbname = ":memory:") + + expect_true(inherits(sqlite_cache, "cache_sqlite")) + expect_length(sqlite_cache$keys(), 0L) + + sqlite_cache$set("hello", list(value = 42)) + expect_true(sqlite_cache$has_key("hello")) + expect_equal(sqlite_cache$get("hello"), list(value = 42)) + + sqlite_cache$set("world", "abc") + expect_setequal(sqlite_cache$keys(), c("hello", "world")) + + sqlite_cache$remove("hello") + expect_false(sqlite_cache$has_key("hello")) + + sqlite_cache$reset() + expect_length(sqlite_cache$keys(), 0L) +}) + +test_that("cache_sqlite is compatible with {memoise}", { + skip_if_not_installed("RSQLite") + skip_if_not_installed("memoise") + + sqlite_cache <- cache_sqlite$new(dbname = ":memory:") + f <- function(x) sample(1:1000, x) + mf <- memoise::memoise(f, cache = sqlite_cache) + expect_equal(mf(5), mf(5)) + expect_true(length(sqlite_cache$keys()) >= 1L) +}) + +test_that("missing key returns a key_missing sentinel", { + skip_if_not_installed("RSQLite") + + sqlite_cache <- cache_sqlite$new(dbname = ":memory:") + res <- sqlite_cache$get("nope") + expect_s3_class(res, "key_missing") +}) + +test_that("set() overwrites an existing key", { + skip_if_not_installed("RSQLite") + + sqlite_cache <- cache_sqlite$new(dbname = ":memory:") + sqlite_cache$set("k", "first") + sqlite_cache$set("k", "second") + expect_equal(sqlite_cache$get("k"), "second") + expect_length(sqlite_cache$keys(), 1L) +}) + +test_that("opening an existing table with a foreign schema errors clearly", { + skip_if_not_installed("RSQLite") + skip_if_not_installed("DBI") + + path <- tempfile(fileext = ".sqlite") + on.exit(unlink(path), add = TRUE) + con <- DBI::dbConnect(RSQLite::SQLite(), dbname = path) + DBI::dbExecute(con, "CREATE TABLE bankrcache (foo TEXT, bar TEXT);") + DBI::dbDisconnect(con) + + expect_error( + cache_sqlite$new(dbname = path), + regexp = "does not match the cache schema" + ) +}) + +test_that("file-backed sqlite cache persists across sessions", { + skip_if_not_installed("RSQLite") + + path <- tempfile(fileext = ".sqlite") + on.exit(unlink(path), add = TRUE) + + c1 <- cache_sqlite$new(dbname = path) + c1$set("alpha", list(x = 1L, y = 2L)) + rm(c1) + gc() + + c2 <- cache_sqlite$new(dbname = path) + expect_true(c2$has_key("alpha")) + expect_equal(c2$get("alpha"), list(x = 1L, y = 2L)) +})