R/sqlite_db.R

In danielkovtun/shinyNotes: Shiny Module for Taking Free-Form Notes

#' @title Add schema to a SQLite database
#' @description Wrapper function to create a new schema in a SQLite database for
#'   local development.
#'   
#' @param schema Schema name
#' @param con A \code{\link[=RSQLite]{SQLiteConnection-class}} object, produced
#'   by \code{\link[=DBI]{dbConnect()}} or \code{shinyNotes::connect_sqlite()}
#'   
#' @return None. Executes SQL query and returns silently.
#' 
#' @examples
#' con <- connect_sqlite()
#' create_schema(con, schema = "demo")
#'
#' @importFrom magrittr "%>%"
#' @export
create_schema <- function(schema, con){
  # Add auxilary schema
  result <- tryCatch({
    tmp <- tempfile()
    DBI::dbExecute(con, paste0("ATTACH '", tmp, "' AS ", schema))
  })
  
}

#' @title Connect to an SQLite database
#' @description Wrapper function to return a
#'   \code{\link[=RSQLite]{SQLiteConnection}} object for local development.
#'
#' @param auto_disconnect Should the connection be automatically closed when the
#'   \code{src} is deleted? Set to \code{TRUE} if you initialize the connection
#'   the call to \code{src_dbi()}. Pass \code{NA} to auto-disconnect but print a
#'   message when this happens.
#'
#' @return Returns an S4 object that inherits from DBIConnection. This object is
#'   used to communicate with the database engine. Under the hood,
#'   \code{dbConnect()} returns an object of class \code{SQLiteConnection}. See
#'   \code{\link[=DBI]{dbConnect()}} for more details.
#'
#' @examples
#' connect_sqlite()
#'
#' @importFrom magrittr "%>%"
#' @export
connect_sqlite <- function(auto_disconnect = TRUE){
  con <- DBI::dbConnect(RSQLite::SQLite(), ":memory:")
  src <- dbplyr::src_dbi(con, auto_disconnect = auto_disconnect)
  return(con)  
}

#' @title Read remote database tables into data frames with additional
#'   validation
#' @description Wrapper function to read table from default or custom schema,
#'   and return \code{NA} by default if an error is encountered.
#'
#' @param con An object that inherits from
#'   \code{\link[=DBI]{DBIConnection-class}}, typically generated by
#'   \code{\link[=DBI]{dbConnect()}}
#' @param table A character string specifying the DBMS table name.
#' @param schema A character string specifying the schema in which the table is
#'   nested.
#' @param collect A logical specifying whether the query results should be
#'   collected into memory or left as a lazy query.
#' @param error_value Error value to return if \code{\link[=DBI]{dbReadTable()}}
#'   fails. Default is \code{NA}.
#'
#' @return If the SQL query executes successfully, the return value will be an
#'   object of class \code{\link[=tibble]{tibble}}. If an error is encountered,
#'   the return value will be inherited from the \code{error_value} argument
#'   provided (default is \code{NA}).
#'
#' @examples
#' con <- connect_sqlite(auto_disconnect = FALSE)
#' dplyr::copy_to(con, iris, "df", temporary = FALSE)
#' db.read_table(con = con, table = 'df')
#'
#' @importFrom magrittr "%>%"
#'
#' @export
db.read_table <- function(con, table, schema=NA, collect=TRUE, error_value=NA) {
  message(paste0("Reading table ", table, "\n"))
  res <- tryCatch({
    if(is.na(schema)){
      qry <- paste0('SELECT * FROM "', table, '"')
    } else{
      qry <- paste0('SELECT * FROM "', schema, '".', '"', table, '"')
    }
    qry <- dplyr::sql(qry) 
    tbl_qry <- dplyr::tbl(con, qry)
    
    if (collect) {
      tbl_qry <- tbl_qry %>% dplyr::collect()
    }
    tbl_qry
  },
  error = function(error_message) {
    return(error_value)
  }
  )
  return(res)
}


#' @title Write data frames to remote database tables with additional validation
#' @description Wrapper function to write data to table in default or custom
#'   schema. Returns \code{TRUE} if successful, \code{FALSE} otherwise.
#'   
#' @param con An object that inherits from
#'   \code{\link[=DBI]{DBIConnection-class}}, typically generated by
#'   \code{\link[=DBI]{dbConnect()}}
#' @param data A \code{data.frame}, \code{tbl}, or other valid SQL data type
#'   containing the data to write to the database.
#' @param table A character string specifying the DBMS table name.
#' @param schema A character string specifying the schema in which the table is
#'   nested.
#' @param append_only A logical specifying whether the operation is
#'   \code{INSERT} or \code{UPDATE}. Default of \code{append_only = FALSE} means
#'   execute \code{DELETE} on table, and update with new data.
#' @param drop_overwrite A logical specifying whether the operation is
#'   \code{DROP} and \code{INSERT}. This will overwrite any existing field
#'   types.
#'   
#' @return Returns \code{TRUE} if the SQL query executes successfully,
#'   \code{FALSE} otherwise.
#'   
#' @examples
#' connection <- connect_sqlite(auto_disconnect = FALSE)
#'
#' db.write_table(con = connection, table = 'iris', data = iris)
#'
#' @export
db.write_table <- function(con, data, table, schema = NA, append_only = FALSE, drop_overwrite = NA){
  ## Add backup read - don't commit DELETE immediately
  if(!is.na(schema)){
    qry <- paste0('DELETE FROM "', schema, '".', '"', table, '";') %>% dplyr::sql()
    table_id <- DBI::Id(schema = schema, table = table)
  } else{
    qry <- paste0('DELETE FROM "', table, '";') %>% dplyr::sql()
    table_id <- table
  }

  res <- tryCatch({
    table_exists <- DBI::dbExistsTable(con, table_id)
    if(!table_exists){
      write_status <- DBI::dbWriteTable(con, table_id, data, overwrite = TRUE)
    } else{
      if(!is.na(drop_overwrite)){
        write_status <- DBI::dbWriteTable(con, table_id, data, overwrite = TRUE)
      } else if(append_only){
        write_status <- DBI::dbWriteTable(con,  table_id, data, append = TRUE)
      } else{
        rows_affected <- DBI::dbExecute(con, qry)
        write_status <- DBI::dbWriteTable(con, table_id, data, append = TRUE)
        write_status <- list(rows_affected, write_status)
      }
    }
    write_status
  },
  error = function(error_message) {
    return(error_message)
  })
  
  if ("message" %in% names(res)) {
    warning(paste0("Error writing table ", table, ":", res[["message"]], "\n"))
    return(FALSE)
  } else {
    message(paste0("Table ", table, " successfully updated ", Sys.time(), "\n"))
    return(TRUE)
  }
}