R/helpers.R

In shunsambongi/datafire:

# Driver ------------------------------------------------------------------

#' Helper for making new datafire driver
#'
#' @param name descriptive driver name
#' @param class driver subclass
#' @export
new_driver <- function(name, class = NULL) {
  structure(list(name = name), class = c(class, "datafire_driver"))
}

#' @export
format.datafire_driver <- function(x, ...) {
  ellipsis::check_dots_empty()
  paste0("<", x$name, "Driver>\n")
}

#' @export
print.datafire_driver <- function(x, ...) {
  ellipsis::check_dots_empty()
  cat(format(x))
  invisible(x)
}

# Connection --------------------------------------------------------------

#' Helper for making a new connection
#'
#' @param driver a data firedriver
#' @param ... args passed onto methods
#' @param class name of subclass
#' @seealso [new_driver()]
#' @export
new_connection <- function(driver, ..., class = NULL) {
  con <- list2env(rlang::dots_list(..., .homonyms = "error"), parent = emptyenv())
  structure(con, driver = driver, class = c(class, "datafire_connection"))
}

driver <- function(x) {
  attr(x, "driver")
}

#' @export
print.datafire_connection <- function(x, ...) {
  con_print_header(x, ...)
  con_print_body(x, ...)
  con_print_footer(x, ...)
  invisible(x)
}

#' @export
con_print_header.datafire_connection <- function(x, ...) {
  drv <- driver(x)
  cat(paste0("<", drv$name, "Connection>\n"))
  invisible(x)
}

#' @export
con_print_body.datafire_connection <- function(x, ...) {
  try({
    if (is_connected(x)) {
      cat("  CONNECTED\n")
    } else {
      cat("  DISCONNECTED\n")
    }
  }, silent = TRUE)
  invisible(x)
}

#' @export
con_print_footer.datafire_connection <- function(x, ...) {
  invisible(x)
}