#' Connection for 'Redash' Database
#'
#' @name connection
#' @export
#' @keywords internal
setClass("RedashConnection",
contains = "DBIConnection",
slots = list(
base_url = "character",
api_key = "character",
data_source_id = "integer",
backend_connection_class = "character",
ref = "environment"
)
)
#' @param drv An object created by `Redash`
#' @rdname connection
#' @export
#' @examples
#' \dontrun{
#' db <- dbConnect(Redashr::Redash())
#' dbWriteTable(db, "mtcars", mtcars)
#' dbGetQuery(db, "SELECT * FROM mtcars WHERE cyl == 4")
#' }
setMethod("dbConnect", "RedashDriver",
function(drv,
base_url = "http://localhost",
api_key = "",
data_source_name = NULL,
...) {
# TODO: normalize host
data_sources <- get_data_sources(base_url, api_key)
if (is.null(data_source_name)) {
if (length(data_sources) == 1L) {
data_source <- data_sources[[1]]
warning(glue::glue("Using {data_source$name} as data source for now, but please provide data_source_name."),
call. = FALSE)
} else {
stop("Please provide data_source_name.")
}
} else {
data_source <- data_sources[[data_source_name]]
if (is.null(data_source)) {
stop(glue::glue("No such data source: {data_source_name}"))
}
}
data_source_id <- data_source$id
# TODO: support more backends
backend_connection_class <- switch(
data_source$type,
"pg" = prepare_connection_class("RPostgreSQL", "PostgreSQLConnection"),
"redshift" = prepare_connection_class("RPostgreSQL", "PostgreSQLConnection"),
"mysql" = prepare_connection_class("RMySQL", "MySQLConnection"),
"rds_mysql" = prepare_connection_class("RMySQL", "MySQLConnection"),
"presto" = prepare_connection_class("RPresto", "PrestoConnection"),
prepare_connection_class("DBI", "DBIConnection")
)
ref_env <- new.env(parent = emptyenv())
ref_env$query_id <- 0L
new("RedashConnection",
base_url = base_url,
api_key = api_key,
data_source_id = data_source_id,
backend_connection_class = backend_connection_class,
ref = ref_env,
...)
})
#' @export
redash_connect <- function(base_url, api_key, data_source_name = NULL) {
drv <- Redash()
dbConnect(drv, base_url, api_key, data_source_name)
}
setGeneric("query_id", function(x) standardGeneric("query_id"))
setMethod("query_id", "RedashConnection", function(x) {
x@ref$query_id <- x@ref$query_id + 1L
x@ref$query_id
})
#' @export
setMethod("dbDisconnect", "RedashConnection", function(conn, ...) {
invisible(TRUE)
})
#' @export
setMethod("dbListTables", "RedashConnection", function(conn, ...) {
# TODO: support multiple backend
dbGetQuery(conn, paste0(
"SELECT tablename FROM pg_tables WHERE schemaname !='information_schema'",
" AND schemaname !='pg_catalog'")
)[[1]]
})
#' @export
setMethod("sqlCreateTable", "RedashConnection",
function(con, table, fields, row.names = NA, temporary = FALSE, ...) {
sqlCreateTable(new(con@backend_connection_class), table, fields, row.names, temporary, ...)
}
)
#' @export
setMethod("sqlAppendTable", "RedashConnection",
function(con, table, values, row.names = NA, ...) {
sqlAppendTable(new(con@backend_connection_class), table, values, row.names, ...)
}
)
#' @export
setMethod("sqlData", "RedashConnection",
function(con, table, values, row.names = NA, ...) {
sqlData(new(con@backend_connection_class), values, row.names, ...)
}
)
#' @export
setMethod("dbWriteTable", "RedashConnection",
function (conn, name, value, ...) {
dbSendStatement(conn, sqlCreateTable(conn, name, value))
dbSendStatement(conn, sqlAppendTable(conn, name, value))
}
)
#' @export
db_begin.RedashConnection <- function(con, ...) NULL
#' @export
db_commit.RedashConnection <- function(con, ...) NULL
#' @export
db_rollback.RedashConnection <- function(con, ...) NULL
prepare_connection_class <- function(package, class) {
if (require(package, character.only = TRUE)) return(class)
warning(glue::glue("Couldn't load {package}; falling back to DBI::DBIConnection, where SQL translations are not work well."))
"DBIConnection"
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.