R/01_set_db_env.R

# 3 environments are actually created by `set_env_db`, they enclose each other and
# the grand-child is returned.
#
# - The grand parent contains the functions that we want to make accessible, i.e.
# `:=`, `!.db_table_name`, `?` and helpers
# - The parent contains definitions of forbidden functions `<-`, `<<-`, `=` and `rm`
# - The returned  environment contains only db_table_name objects


#' set a database environment
#'
#' @param con a connection object
#' @importFrom stats setNames
#'
#' @export
set_db_env <- function(con){

#########
# env1 #
########

# create list of all functions
funs <- list(
  db_exists = db_exists,
  db_remove = db_remove,
  db_rename = db_rename,
  db_query  = db_query,
  db_create = db_create,
  db_upload = db_upload,
  `!.db_table_name` = `!.db_table_name`,
  `:=` = `:=`)

# create new environment, make it their enclosing environment and bind them to it
env1 <- new.env(parent = parent.frame(2))
funs <- lapply(funs, `environment<-`, env1)
list2env(funs, envir = env1)

# `?` is bound in env1 but we must leave it enclosed in dplyr's namespace so it
# can access other functions
env1$`?` <- dplyr::collect

#########
# env2 #
########

# create a children environment with only `<-` returning error
env2 <- new.env(parent = env1)
env2[["<-"]] <- function(e1, e2) {
  stop("The use of `<-`, `=` and `<<-` is forbidden in this environment.\n",
       "Use `:=` to assign either in the database or the calling environment.")
}
env2[["rm"]] <- function(...) {
  stop("The use of `rm` is forbidden in this environment.\n",
       "Use `!my_table := NULL` to remove it from the database and environment")
}
env2[["="]]   <- env2[["<-"]]
env2[["<<-"]] <- env2[["<-"]]
environment(env2[["<-"]]) <- env2
environment(env2[["="]]) <- env2
environment(env2[["<<-"]]) <- env2
environment(env2[["rm"]]) <- env2

#########
# env3 #
########

env3 <- new.env(parent = env2)
# create a grand children environment where db tables live, as characters
# with a class "mmdb_table"
all_tbls_chr <-  DBI::dbListTables(con)

# build objects with quoted tbl(con, my_table) call for each of them
all_tbls <- lapply(setNames(all_tbls_chr, all_tbls_chr), `class<-`, "db_table_name")
# execute them in an environment containing all_tables, and with_db_funs one
# layer up (so running `ls()` will only return content of db)

list2env(all_tbls, env3)


############################################
# bind environments and connection to env1 #
############################################

env1$call_env <- parent.frame()
env1$db <- env3
env1$con <- con

env3
}
moodymudskipper/mmdb documentation built on May 19, 2019, 12:37 a.m.