Merge pull request #67 from marcusmunch/sqlite_schema

DESCRIPTION

@@ -21,7 +21,7 @@ Roxygen: list(markdown = TRUE, r6 = TRUE)
 Imports:
     checkmate,
     DBI,
-    dbplyr,
+    dbplyr (>= 2.4.0),
     dplyr,
     glue,
     lubridate,

NAMESPACE

@@ -3,6 +3,17 @@
 S3method(db_timestamp,"NULL")
 S3method(db_timestamp,SQLiteConnection)
 S3method(db_timestamp,default)
+S3method(get_schema,Id)
+S3method(get_schema,PqConnection)
+S3method(get_schema,SQLiteConnection)
+S3method(get_schema,tbl_dbi)
+S3method(get_tables,SQLiteConnection)
+S3method(get_tables,default)
+S3method(schema_exists,PqConnection)
+S3method(schema_exists,SQLiteConnection)
+S3method(schema_exists,default)
+S3method(table_exists,SQLiteConnection)
+S3method(table_exists,default)
 S3method(tidyr::unite,tbl_dbi)
 export("%notin%")
 export(Logger)

NEWS.md

@@ -2,6 +2,7 @@
 
 ## Minor improvements and fixes
 
+* SQLite connections now support schemata similar to other backends (@marcusmunch, #67)
 * Package logo slightly altered to have a readable clock (@RasmusSkytte, #49)
 * Added a vignette describing the concept of a slowly changing dimension using examples (@marcusmunch, #53)
 * Added a `Logger$finalize` method which removes the `log_file` in the DB when not writing to a file (@marcusmunch, #66)

R/connection.R

@@ -116,30 +116,32 @@ close_connection <- function(conn) {
 #'
 #' @template db_table_id
 #' @template conn
+#' @param allow_table_only
+#'  logical. If `TRUE`, allows for returning an `DBI::Id` with `table` = `myschema.table` if schema `myschema`
+#'  is not found in `conn`.
 #' @details The given db_table_id is parsed using an assumption of "schema.table" syntax into
 #'  a DBI::Id object with corresponding schema (if the conn supports it) and table values.
 #' @return A DBI::Id object parsed from db_table_id
 #' @examples
 #' id("schema.table")
 #' @seealso [DBI::Id] which this function wraps.
 #' @export
-id <- function(db_table_id, conn = NULL) {
+id <- function(db_table_id, conn = NULL, allow_table_only = TRUE) {
 
   # Check if already Id
   if (inherits(db_table_id, "Id")) return(db_table_id)
 
   # Check arguments
   checkmate::assert_character(db_table_id)
 
-  # SQLite does not have schemas
-  if (inherits(conn, "SQLiteConnection")) {
-    return(DBI::Id(table = db_table_id))
-  }
-
   if (stringr::str_detect(db_table_id, "\\.")) {
     db_name <- stringr::str_split_1(db_table_id, "\\.")
     db_schema <- db_name[1]
     db_table  <- db_name[2]
+
+    if (allow_table_only && !is.null(conn) && !schema_exists(conn, db_schema)) {
+      return(DBI::Id(table = db_table_id))
+    }
   } else {
     db_schema <- NULL
     db_table <- db_table_id

R/create_table.R

@@ -99,8 +99,9 @@ methods::setMethod("getTableSignature", "NULL", function(.data, conn) {
 #' @return A tbl_dbi with the generated (or existing) log table
 #' @examples
 #' conn <- get_connection(drv = RSQLite::SQLite())
+#' log_table_id <- id("test.logs", conn = conn, allow_table_only = TRUE)
 #'
-#' create_logs_if_missing("test.logs", conn)
+#' create_logs_if_missing(log_table_id, conn)
 #'
 #' close_connection(conn)
 #' @export

R/db_manipulating_functions.R

@@ -133,19 +133,22 @@ unite.tbl_dbi <- function(data, col, ..., sep = "_", remove = TRUE, na.rm = FALS
 #' @examples
 #' conn <- get_connection(drv = RSQLite::SQLite())
 #'
-#' t1 <- data.frame(key = c("A", "A", "B"),
-#'                  obs_1   = c(1, 2, 2),
-#'                  valid_from  = as.Date(c("2021-01-01", "2021-02-01", "2021-01-01")),
-#'                  valid_until = as.Date(c("2021-02-01", "2021-03-01", NA)))
-#' t1 <- dplyr::copy_to(conn, t1, id("test.SCDB_tmp1", conn), overwrite = TRUE, temporary = FALSE)
 #'
-#' t2 <- data.frame(key = c("A", "B"),
-#'                  obs_2 = c("a", "b"),
-#'                  valid_from  = as.Date(c("2021-01-01", "2021-01-01")),
-#'                  valid_until = as.Date(c("2021-04-01", NA)))
-#' t2 <- dplyr::copy_to(conn, t2, id("test.SCDB_tmp2", conn), overwrite = TRUE, temporary = FALSE)
+#' if (schema_exists(conn, "test")) {
+#'   t1 <- data.frame(key = c("A", "A", "B"),
+#'                   obs_1   = c(1, 2, 2),
+#'                   valid_from  = as.Date(c("2021-01-01", "2021-02-01", "2021-01-01")),
+#'                   valid_until = as.Date(c("2021-02-01", "2021-03-01", NA)))
+#'   t1 <- dplyr::copy_to(conn, t1, id("test.SCDB_tmp1", conn), overwrite = TRUE, temporary = FALSE)
 #'
-#' interlace_sql(list(t1, t2), by = "key")
+#'   t2 <- data.frame(key = c("A", "B"),
+#'                   obs_2 = c("a", "b"),
+#'                   valid_from  = as.Date(c("2021-01-01", "2021-01-01")),
+#'                   valid_until = as.Date(c("2021-04-01", NA)))
+#'   t2 <- dplyr::copy_to(conn, t2, id("test.SCDB_tmp2", conn), overwrite = TRUE, temporary = FALSE)
+#'
+#'   interlace_sql(list(t1, t2), by = "key")
+#' }
 #'
 #' close_connection(conn)
 #' @return          The combination of input queries with a single, interlaced

R/get_schema.R

@@ -1,44 +1,48 @@
-#' Get the current schema of a DB connection
+#' Get the current schema of a database-related objects
 #'
-#' @param .x A DBIConnection or lazy_query object
+#' @param .x The object from which to retrieve a schema
 #' @return The current schema name, but defaults to "prod" instead of "public"
 #' @examples
 #' conn <- get_connection(drv = RSQLite::SQLite())
 #'
 #' dplyr::copy_to(conn, mtcars, name = "mtcars")
 #'
 #' get_schema(conn)
-#' get_schema(get_table(conn, "mtcars"))
+#' get_schema(get_table(conn, id("mtcars", conn = conn)))
 #'
 #' close_connection(conn)
 #' @export
 get_schema <- function(.x) {
+  UseMethod("get_schema")
+}
 
-  if (inherits(.x, "PqConnection")) {
-    # Get schema from connection object
-    schema <- DBI::dbGetQuery(.x, "SELECT CURRENT_SCHEMA()")$current_schema
-
-  } else if (inherits(.x, "SQLiteConnection") || inherits(.x, "tbl_SQLiteConnection")) {
-    return()
-  } else if (inherits(.x, "tbl_dbi")) {
-    # Get schema from a DBI object (e.g. lazy query)
-    schema <- stringr::str_extract_all(dbplyr::remote_query(.x), '(?<=FROM \")[^"]*')[[1]]
-    if (length(unique(schema)) > 1) {
-      # Not sure if this is even possible due to dbplyr limitations
-      warning("Multiple different schemas detected. You might need to handle these (more) manually:\n",
-              paste(unique(schema), collapse = ", "))
-    } else {
-      schema <- unique(schema)
-    }
-  } else {
-    stop("Could not detect object type")
-  }
+#' @export
+get_schema.tbl_dbi <- function(.x) {
+  return(unclass(dbplyr::remote_table(.x))$schema)
+}
 
-  if (schema == "public") schema <- "prod"
+#' @export
+get_schema.Id <- function(.x) {
+  return(unname(.x@name["schema"]))
+}
 
-  return(schema)
+#' @export
+get_schema.PqConnection <- function(.x) {
+  return(DBI::dbGetQuery(.x, "SELECT CURRENT_SCHEMA()")$current_schema)
 }
 
+#' @export
+get_schema.SQLiteConnection <- function(.x) {
+  schemata <- unique(get_tables(.x)["schema"])
+
+  if ("main" %in% schemata) {
+    return("main")
+  } else if ("temp" %in% schemata) {
+    return("temp")
+  } else {
+    return()
+  }
+}
 
 #' Test if a schema exists in given connection
 #' @param schema A character string giving the schema name
@@ -53,11 +57,33 @@ get_schema <- function(.x) {
 #' close_connection(conn)
 #' @export
 schema_exists <- function(conn, schema) {
+  UseMethod("schema_exists")
+}
 
-  checkmate::assert_class(conn, "DBIConnection")
-  checkmate::assert_character(schema)
+#' @export
+schema_exists.SQLiteConnection <- function(conn, schema) {
+  query <- paste0(
+    "SELECT schema, name FROM pragma_table_list WHERE schema == '",
+    schema,
+    "' AND name == 'sqlite_schema'"
+  )
+  result <- DBI::dbGetQuery(conn, query)
+
+  return(nrow(result) == 1)
+}
 
-  if (inherits(conn, "SQLiteConnection")) return(FALSE)
+#' @export
+schema_exists.PqConnection <- function(conn, schema) {
+  query <- paste0("SELECT schema_name FROM INFORMATION_SCHEMA.SCHEMATA WHERE schema_name = '", schema, "'")
+  result <- DBI::dbGetQuery(conn, query)
+
+  return(nrow(result) == 1)
+}
+
+#' @export
+schema_exists.default <- function(conn, schema) {
+
+  checkmate::assert_character(schema)
 
   objs <- DBI::dbListObjects(conn)
   matches <- sapply(objs$table, \(.x) methods::slot(.x, "name")) |>

R/get_table.R

@@ -17,7 +17,9 @@
 #' dplyr::copy_to(conn, mtcars, name = "mtcars")
 #'
 #' get_table(conn)
-#' get_table(conn, "mtcars")
+#' if (table_exists(conn, "mtcars")) {
+#'   get_table(conn, "mtcars")
+#' }
 #'
 #' close_connection(conn)
 #' @importFrom rlang .data
@@ -47,7 +49,7 @@ get_table <- function(conn, db_table_id = NULL, slice_ts = NA, include_slice_inf
   }
 
   # Look-up table in DB
-  q <- dplyr::tbl(conn, db_table_id)
+  q <- dplyr::tbl(conn, db_table_id, check_from = FALSE)
 
   # Check whether data is historical
   if (is.historical(q) && !is.null(slice_ts)) {
@@ -83,6 +85,29 @@ get_table <- function(conn, db_table_id = NULL, slice_ts = NA, include_slice_inf
 #' @importFrom rlang .data
 #' @export
 get_tables <- function(conn, pattern = NULL) {
+  UseMethod("get_tables")
+}
+
+#' @export
+get_tables.SQLiteConnection <- function(conn, pattern = NULL) {
+  query <- paste("SELECT schema, name 'table' FROM pragma_table_list",
+                 "WHERE NOT name IN ('sqlite_schema', 'sqlite_temp_schema')",
+                 "AND NOT name LIKE 'sqlite_stat%'")
+
+  if (!is.null(pattern)) {
+    query <- paste0(query, " AND name LIKE '%", pattern, "%'")
+  }
+
+  tables <- DBI::dbGetQuery(conn, query) |>
+    dplyr::mutate(dplyr::across("schema", ~ ifelse(. %in% c("temp", "main"), NA_character_, .)))
+
+  if (nrow(tables) == 0) warning("No tables found. Check user privileges / database configuration")
+
+  return(tables)
+}
+
+#' @export
+get_tables.default <- function(conn, pattern = NULL) {
 
   # Check arguments
   checkmate::assert_class(conn, "DBIConnection")
@@ -182,6 +207,8 @@ slice_time <- function(.data, slice_ts, from_ts = from_ts, until_ts = until_ts)
 #' @template conn
 #' @template db_table_id
 #' @return TRUE if db_table_id can be parsed to a table found in conn
+#' @importFrom rlang .data
+#' @name table_exists
 #' @examples
 #' conn <- get_connection(drv = RSQLite::SQLite())
 #'
@@ -204,11 +231,53 @@ table_exists <- function(conn, db_table_id) {
       return(FALSE)
     })
 
-    return(!isFALSE(exists))
+    return(exists)
+  }
+
+  UseMethod("table_exists", conn)
+}
+
+#' @rdname table_exists
+#' @export
+table_exists.SQLiteConnection <- function(conn, db_table_id) {
+  tables <- get_tables(conn)
+
+  if (inherits(db_table_id, "Id")) {
+    exact_match <- dplyr::filter(tables, .data$table == db_table_id@name["table"])
+
+    if ("schema" %in% names(db_table_id@name)) {
+      exact_match <- dplyr::filter(exact_match, .data$schema == db_table_id@name["schema"])
+    }
+
+    if (nrow(exact_match) == 1) {
+      return(TRUE)
+    }
+
+    db_table_id <- paste(db_table_id@name, collapse = ".")
+  }
+
+  matches <- tables |>
+    tidyr::unite("table_str", "schema", "table", sep = ".", na.rm = TRUE, remove = FALSE) |>
+    dplyr::filter(.data$table_str == !!db_table_id) |>
+    dplyr::select(!"table_str")
+
+  if (nrow(matches) <= 1) {
+    return(nrow(matches) == 1)
   }
 
+  rlang::abort(
+    message = paste0("More than one table matching '", db_table_id, "' was found!"),
+    matches = matches
+  )
+}
+
+#' @rdname table_exists
+#' @export
+table_exists.default <- function(conn, db_table_id) {
   assert_id_like(db_table_id)
 
+  db_table_id <- id(db_table_id, conn = conn)
+
   if (inherits(db_table_id, "Id")) {
     db_name <- attr(db_table_id, "name")
     db_schema <- purrr::pluck(db_name, "schema", .default = NA_character_)