# 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
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.