`!.db_table_name` <- function(x) {
# to avoid CMD check notes:
con <- get("con")
dplyr::tbl(con, unclass(x))
}
# `:=` assigns either to the caling environment or to the database
`:=` <- function(e1, e2){
# to avoid CMD check notes:
call_env <- get("call_env")
e1_quoted <- substitute(e1)
if (is.symbol(e1_quoted)) {
# ASSIGN TO CALLING ENV
e1_chr <- deparse(e1_quoted)
assign(e1_chr, e2, envir = call_env)
return(invisible(NULL))
} else if(e1_quoted[[1]] != quote(`!`) || length(e1_quoted) != 2){
stop("invalid lhs")
}
# ASSIGN TO DATABASE
e1_quoted <- e1_quoted[[2]]
e1_chr <- deparse(e1_quoted)
e2_quoted <- substitute(e2)
if(is.null(e2_quoted)){
# if e2 is NULL, remove e1
db_remove(e1_chr)
} else if(!is.symbol(e2_quoted) && e2_quoted[[1]] == quote(`-`)){
# if e2 is prefixed with `-`
if(is.symbol(e2_quoted[[2]]) ||
e2_quoted[[2]][[1]] != quote(`!`) ||
!is.symbol(e2_quoted[[2]][[2]]))
# fail if next element isn't `!`
stop("invalid rhs")
# extract the name as character
e2_chr <- deparse(e2_quoted[[2]][[2]])
db_rename(from_chr = e2_chr, to_chr = e1_chr)
} else if(is.data.frame(e2)){
# upload table
db_upload(from_chr = e2, to_chr = e1_chr)
} else if (dplyr::is.tbl(e2)){
db_create(from_tbl = e2, to_chr = e1_chr)
} else {
stop("invalid rhs")
}
invisible(NULL)
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.