contract.R

library(RSQLite)
library(MonetDBLite)
library(DBI)

#con <- dbConnect(MonetDBLite::MonetDBLite())
#con <- DBI::dbConnect(RSQLite::SQLite(), path = ":memory:")

dbWriteTable(con, "mtcars", mtcars)
dbWriteTable(con, "breaks", warpbreaks)


dbiListObjectsTypes <- function(connection, ...){
  list(table = list(contains = "data"))
}

dbiListObjects <- function(connection, catalog = NULL, schema = NULL, name = NULL, type = NULL, ...) {
  data.frame(name = dbListTables(connection), type = "table", stringsAsFactors = FALSE)
}

dbiListColumns <- function(connection, table, catalog = NULL, schema = NULL, ...) {
  
  df <- dbiPreviewObject(con, table = table, rowLimit = 10)
  names <- colnames(df)
  types <- as.character(sapply(df, class))
  
  data.frame(name = names, type = types, stringsAsFactors = FALSE)
}

dbiPreviewObject <- function(connection, rowLimit, table = NULL, view = NULL, schema = NULL, ...) {
  # Error if both table and view are passed
  if (!is.null(table) && !is.null(view)) {
    stop("`table` and `view` can not both be used", call. = FALSE)
  }
  
  # Error if neither table and view are passed
  if (is.null(table) && is.null(view)) {
    stop("`table` and `view` can not both be `NULL`", call. = FALSE)
  }
  
  name <- if (!is.null(table)) {
    table
  } else {
    view
  }
  
  # append schema if specified
  if (!is.null(schema)) {
    name <- paste(dbQuoteIdentifier(connection, schema), dbQuoteIdentifier(connection, name), sep = ".")
  }
  
  dbGetQuery(connection, paste("SELECT * FROM", name), n = rowLimit)
}

on_connection_opened <- function(connection){
  observer <- getOption("connectionObserver")
  if (is.null(observer))
    return(invisible(NULL))  
  
  observer$connectionOpened(

  
    connectionObject = connection,
  
    type = as.character(class(connection)), 
    host = as.character(class(connection)), 
    displayName = as.character(class(connection)), 
    
    connectCode = "[TO-DO: Regenerate connection code]",
    disconnect = function(){
      DBI::dbDisconnect(connection)
      on_connection_closed(connection)
      },
    
    previewObject = function(rowLimit, ...){
      dbiPreviewObject(connection, rowLimit, ...)
    },
        
    listObjectTypes = function(...){
      dbiListObjectsTypes(connection)
    },
    
    listObjects = function(...){
      dbiListObjects(connection)
    },
    
    listColumns = function(...){
      dbiListColumns(connection, ...)
    }
  )
}

on_connection_closed <- function(connection) {
  # make sure we have an observer
  observer <- getOption("connectionObserver")
  if (is.null(observer))
    return(invisible(NULL))
  
  type <- as.character(class(connection))
  host <- as.character(class(connection))
  observer$connectionClosed(type, host)
}

on_connection_opened(con)