R/dml-dbtools.R

In tjpalanca/dbtools: Database Tools for R

#' @export
insert.dbtools <- function(object,
                           records = collect(object, n = Inf),
                           batch_size = NULL,
                           returning  = NULL,
                           manip_name = "",
                           commit = FALSE,
                           ...) {

  get_tbl_db(object) %>%
    transact() %>%
    manipulate(
      dbxInsert(
        conn  = get_tbl_db_conn(.),
        table = get_tbl_db_from(.),
        records    = records,
        batch_size = batch_size,
        returning  = returning
      ),
      commit = commit,
      name = manip_name
    )

}

#' @export
update.dbtools <- function(object,
                           records = collect(object, n = Inf),
                           where_cols = NULL,
                           batch_size = NULL,
                           manip_name = "",
                           commit = FALSE,
                           ...) {

  get_tbl_db(object) %>%
    transact() %>%
    manipulate(
      dbxUpdate(
        conn  = get_tbl_db_conn(.),
        table = get_tbl_db_from(.),
        records     = records,
        where_cols  = where_cols %||% get_tbl_db_pkey(.),
        batch_size  = batch_size,
        transaction = FALSE
      ),
      commit = commit,
      name = manip_name
    )

}

#' @export
upsert.dbtools <- function(object,
                           records = collect(object, n = Inf),
                           where_cols = NULL,
                           batch_size = NULL,
                           returning  = NULL,
                           skip_existing = FALSE,
                           manip_name = "",
                           commit = FALSE,
                           ...) {

  get_tbl_db(object) %>%
    transact() %>%
    manipulate(
      dbxUpsert(
        conn  = get_tbl_db_conn(.),
        table = get_tbl_db_from(.),
        records    = records,
        where_cols = where_cols %||% get_tbl_db_pkey(.),
        batch_size = batch_size,
        returning  = returning,
        skip_existing = skip_existing
      ),
      commit = commit,
      name = manip_name
    )

}

#' @export
delete.dbtools <- function(object,
                           records = collect(object, n = Inf),
                           batch_size = NULL,
                           manip_name = "",
                           commit = FALSE,
                           ...) {

  get_tbl_db(object) %>%
    transact() %>%
    manipulate(
      dbxDelete(
        conn  = get_tbl_db_conn(.),
        table = get_tbl_db_from(.),
        where = records,
        batch_size = batch_size
      ),
      commit = commit,
      name = manip_name
    )

}

manipulate <- function(tbl_db, manip, commit, name = "") {

  attr(tbl_db, "manips") <- append(
    attr(tbl_db, "manips"),
    set_names(list(as_tibble(manip)), assert_string(name))
  )

  tbl_db$ops <- get_tbl_db_root(tbl_db)

  if (commit) {
    commit(tbl_db)
  } else {
    tbl_db
  }

}