R/utils.R

In poissonconsulting/createsqlite: Tools to generate SQLite database creation scripts

is.blob <- function(x) inherits(x, "blob")
is.POSIXct <- function(x) inherits(x, "POSIXct")
is.Date <- function(x) inherits(x, "Date")
is.sfc <- function(x) inherits(x, "sfc")

get_class <- function(x){
  if(is.Date(x)) return("TEXT")
  if(is.POSIXct(x)) return("TEXT")
  if(is.integer(x)) return("INTEGER")
  if(is.double(x)) return("REAL")
  if(is.logical(x)) return("BOOLEAN")
  if(is.blob(x)) return("BLOB")
  if(is.sfc(x)) return("BLOB")
  "TEXT"
}

get_null <- function(x){
  ifelse(any(is.na(x)), "", " NOT NULL")
}

get_check <- function(x, name){
  if(is.sfc(x))
    return()
  if(is.Date(x))
    return(paste0("LENGTH(", name, ") == 10 AND\n DATE(", name, ") IS NOT NULL AND\n", name, " >= '", min(x, na.rm = TRUE), "'"))
  if(is.POSIXct(x))
    return(paste0("LENGTH(", name, ") == 19 AND\n DATETIME(", name, ") IS NOT NULL AND\n", name, " >= '", min(x, na.rm = TRUE), "'"))
  if(is.numeric(x))
    return(paste0(name, " >= ", min(x, na.rm = TRUE), " AND ", name, " <= ", max(x, na.rm = TRUE)))
  if(is.factor(x))
    return(paste0(name, " IN (", paste0("'", levels(x), "'", collapse = ", "), ")"))
  if(is.logical(x))
    return(paste0(name, " IN ('0', '1')"))
}

df_class <- function(data){
  sapply(names(data), function(x){
    paste0(x, " ", get_class(data[[x]]), get_null(data[[x]]))
  })
}

df_check <- function(data){
  sapply(names(data), function(x) get_check(data[[x]], x))
}

df_unique <- function(data){
  lapply(names(data), function(x){
    if(!any(duplicated(data[[x]]))){return(x)}
  }) %>% unlist
}

### Guess key by trying column 1, then columns 1:2, etc. until unique.
df_key <- function(data){
  for (i in seq_along(data)) {
    y <- data[1:i]
    if (!anyDuplicated(y)) {
      return(names(y))
    }
  }
  character(0)
}

schema_construct <- function(table_name, class, check, unique, key){
  check_string(table_name)
  checkor(check_vector(class, ""), check_null(class))
  checkor(check_vector(check, ""), check_null(check))
  checkor(check_vector(unique, ""), check_null(unique))
  checkor(check_vector(key, ""), check_null(key))

  paste0("DBI::dbGetQuery(conn,\n \"CREATE TABLE ", table_name, " (\n",
         paste0(class, collapse = ",\n"), ",\n",
         "CHECK(\n",
         paste0(check, collapse = " AND\n"),
         "\n),\n",
         "FOREIGN KEY() REFERENCES ()\n",
         paste0("UNIQUE (", unique, ")", collapse = "\n"), "\n",
         paste0("PRIMARY KEY (", paste0(key, collapse = ", "), ")"))
}

schema_wrapper <- function(x){
  check_string(x)
  sprintf("DBI::dbSendQuery(conn, \"%s\")", x)
}

schema_collapse <- function(x){
  checkor(check_vector(x), check_list(x))
  paste(x, collapse = "\n\n")
}

poisson_header <- function(x = "~/Poisson/Databases/test.sqlite"){
  header <- function(x){
    sprintf("source(header.R)\n\nsubfoldr2::sbf_set_sub(\"prepare\")\n\nsubfoldr2::sbf_load_datas()\n\nconn <- readwritesqlite::rws_open_connection(\"%s\")\n\n", x)
  }
  if(inherits(x, "SQLiteConnection")){
    path_conn <- gsub(".sqlite", "-copy.sqlite", conn@dbname)
    return(header(path_conn))
  }
  if(inherits(x, "character")){
    return(header(x))
  }
  NULL
}

poisson_footer <- function(x = "environment()"){
  sprintf("\n\nreadwritesqlite::rws_write_sqlite(%s, conn)", x)
}