R/03_operators.R

`!.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)
}
moodymudskipper/mmdb documentation built on May 19, 2019, 12:37 a.m.