-
Notifications
You must be signed in to change notification settings - Fork 2
Commit
This commit does not belong to any branch on this repository, and may belong to a fork outside of the repository.
Merge pull request #95 from ssi-dk/chore/restructuring
Move functions to separate files
- Loading branch information
Showing
38 changed files
with
1,274 additions
and
1,251 deletions.
There are no files selected for viewing
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| Original file line number | Diff line number | Diff line change |
|---|---|---|
| @@ -0,0 +1,34 @@ | ||
| #' Create a table with the SCDB log structure if it does not exists | ||
| #' @template conn | ||
| #' @param log_table A specification of where the logs should exist ("schema.table") | ||
| #' @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(log_table_id, conn) | ||
| #' | ||
| #' close_connection(conn) | ||
| #' @export | ||
| create_logs_if_missing <- function(log_table, conn) { | ||
|
|
||
| checkmate::assert_class(conn, "DBIConnection") | ||
|
|
||
| if (!table_exists(conn, log_table)) { | ||
| log_signature <- data.frame(date = as.POSIXct(NA), | ||
| schema = NA_character_, | ||
| table = NA_character_, | ||
| n_insertions = NA_integer_, | ||
| n_deactivations = NA_integer_, | ||
| start_time = as.POSIXct(NA), | ||
| end_time = as.POSIXct(NA), | ||
| duration = NA_character_, | ||
| success = NA, | ||
| message = NA_character_, | ||
| log_file = NA_character_) | ||
|
|
||
| DBI::dbCreateTable(conn, id(log_table, conn), log_signature) | ||
| } | ||
|
|
||
| return(dplyr::tbl(conn, id(log_table, conn), check_from = FALSE)) | ||
| } |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| Original file line number | Diff line number | Diff line change |
|---|---|---|
| @@ -0,0 +1,68 @@ | ||
| #' Filters .data according to all records in the filter | ||
| #' | ||
| #' @description | ||
| #' If filter = NULL, not filtering is done | ||
| #' If filter is different from NULL, the .data is filtered by a inner_join using all columns of the filter: | ||
| #' \code{inner_join(.data, filter, by = colnames(filter))} | ||
| #' | ||
| #' by and na_by can overwrite the inner_join columns used in the filtering | ||
| #' | ||
| #' @template .data | ||
| #' @template filters | ||
| #' @param by passed to inner_join if different from NULL | ||
| #' @param na_by passed to inner_join if different from NULL | ||
| #' @template .data_return | ||
| #' @examples | ||
| #' # Filtering with null means no filtering is done | ||
| #' filter <- NULL | ||
| #' identical(filter_keys(mtcars, filter), mtcars) # TRUE | ||
| #' | ||
| #' # Filtering by vs = 0 | ||
| #' filter <- data.frame(vs = 0) | ||
| #' identical(filter_keys(mtcars, filter), dplyr::filter(mtcars, vs == 0)) # TRUE | ||
| #' | ||
| #' # Filtering by the specific combinations of vs = 0 and am = 1 | ||
| #' filter <- dplyr::distinct(mtcars, vs, am) | ||
| #' filter_keys(mtcars, filter) | ||
| #' | ||
| #' @importFrom rlang .data | ||
| #' @export | ||
| filter_keys <- function(.data, filters, by = NULL, na_by = NULL) { | ||
| if (is.null(filters)) { | ||
| return(.data) | ||
| } | ||
|
|
||
| assert_data_like(.data) | ||
| assert_data_like(filters, null.ok = TRUE) | ||
| checkmate::assert_subset(c(by, na_by), colnames(filters)) | ||
|
|
||
| UseMethod("filter_keys") | ||
| } | ||
|
|
||
| #' @export | ||
| filter_keys.tbl_sql <- function(.data, filters, by = NULL, na_by = NULL) { | ||
|
|
||
| if (is.null(by) && is.null(na_by)) { | ||
| # Determine key types | ||
| key_types <- filters |> | ||
| dplyr::ungroup() |> | ||
| dplyr::summarise(dplyr::across( | ||
| .cols = tidyselect::everything(), | ||
| .fns = ~ sum(ifelse(is.na(.), 0, 1), na.rm = TRUE) | ||
| )) |> | ||
| tidyr::pivot_longer(tidyselect::everything(), names_to = "column_name", values_to = "is_na") | ||
|
|
||
| by <- key_types |> dplyr::filter(.data$is_na > 0) |> dplyr::pull("column_name") | ||
| na_by <- key_types |> dplyr::filter(.data$is_na == 0) |> dplyr::pull("column_name") | ||
|
|
||
| if (length(by) == 0) by <- NULL | ||
| if (length(na_by) == 0) na_by <- NULL | ||
| } | ||
| return(dplyr::inner_join(.data, filters, by = by, na_by = na_by)) | ||
| } | ||
|
|
||
| #' @export | ||
| filter_keys.data.frame <- function(.data, filters, by = NULL, na_by = NULL) { | ||
| if (is.null(by) && is.null(na_by)) by <- colnames(filters) | ||
| return(dplyr::inner_join(.data, filters, by = c(by, na_by))) | ||
| } |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| Original file line number | Diff line number | Diff line change |
|---|---|---|
| @@ -0,0 +1,44 @@ | ||
| #' @importFrom methods setGeneric | ||
| methods::setGeneric("getTableSignature", | ||
| function(.data, conn = NULL) standardGeneric("getTableSignature"), | ||
| signature = "conn") | ||
|
|
||
| methods::setMethod("getTableSignature", "DBIConnection", function(.data, conn) { | ||
| # Define the column types to be updated based on backend class | ||
| col_types <- DBI::dbDataType(conn, .data) | ||
|
|
||
| backend_coltypes <- list( | ||
| "PqConnection" = c( | ||
| checksum = "TEXT", | ||
| from_ts = "TIMESTAMP", | ||
| until_ts = "TIMESTAMP" | ||
| ), | ||
| "SQLiteConnection" = c( | ||
| checksum = "TEXT", | ||
| from_ts = "TEXT", | ||
| until_ts = "TEXT" | ||
| ), | ||
| "Microsoft SQL Server" = c( | ||
| checksum = "varchar(32)", | ||
| from_ts = "DATETIME2", | ||
| until_ts = "DATETIME2" | ||
| ) | ||
| ) | ||
|
|
||
| checkmate::assert_choice(class(conn), names(backend_coltypes)) | ||
|
|
||
| # Update columns with indices instead of names to avoid conflicts | ||
| special_cols <- backend_coltypes[[class(conn)]] | ||
| special_indices <- (1 + length(.data) - length(special_cols)):length(.data) | ||
|
|
||
| return(replace(col_types, special_indices, special_cols)) | ||
| }) | ||
|
|
||
| methods::setMethod("getTableSignature", "NULL", function(.data, conn) { | ||
| # Emulate product of DBI::dbDataType | ||
| signature <- dplyr::summarise(.data, dplyr::across(tidyselect::everything(), ~ class(.)[1])) | ||
|
|
||
| stats::setNames(as.character(signature), names(signature)) | ||
|
|
||
| return(signature) | ||
| }) |
Oops, something went wrong.