1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
|
#' Generate SQL from R expressions
#'
#' Low-level building block for generating SQL from R expressions.
#' Strings are escaped; names become bare SQL identifiers. User infix
#' functions have `%` stripped.
#'
#' Using `sql_expr()` in package will require use of [globalVariables()]
#' to avoid `R CMD check` NOTES. This is a small amount of additional pain,
#' which I think is worthwhile because it leads to more readable translation
#' code.
#'
#' @param x A quasiquoted expression
#' @param con Connection to use for escaping. Will be set automatically when
#' called from a function translation.
#' @param .fn Function name (as string, call, or symbol)
#' @param ... Arguments to function
#' @keywords internal
#' @export
#' @examples
#' con <- simulate_dbi() # not necessary when writing translations
#'
#' sql_expr(f(x + 1), con = con)
#' sql_expr(f("x", "y"), con = con)
#' sql_expr(f(x, y), con = con)
#'
#' x <- ident("x")
#' sql_expr(f(!!x, y), con = con)
#'
#' sql_expr(cast("x" %as% DECIMAL), con = con)
#' sql_expr(round(x) %::% numeric, con = con)
#'
#' sql_call2("+", quote(x), 1, con = con)
#' sql_call2("+", "x", 1, con = con)
sql_expr <- function(x, con = sql_current_con()) {
x <- enexpr(x)
x <- replace_expr(x, con = con)
sql(x)
}
#' @export
#' @rdname sql_expr
sql_call2 <- function(.fn, ..., con = sql_current_con()) {
fn <- call2(.fn, ...)
fn <- replace_expr(fn, con = con)
sql(fn)
}
replace_expr <- function(x, con) {
if (is.atomic(x) || blob::is_blob(x)) {
as.character(escape(unname(x), con = con))
} else if (is.name(x)) {
as.character(x)
# } else if (is.call(x) && identical(x[[1]], quote(I))) {
# escape(ident(as.character(x[[2]])))
} else if (is.call(x)) {
fun <- toupper(as.character(x[[1]]))
args <- lapply(x[-1], replace_expr, con = con)
if (is_infix_base(fun)) {
if (length(args) == 1) {
paste0(fun, args[[1]])
} else {
paste0(args[[1]], " ", fun, " ", args[[2]])
}
} else if (is_infix_user(fun)) {
fun <- substr(fun, 2, nchar(fun) - 1)
paste0(args[[1]], " ", fun, " ", args[[2]])
} else if (fun == "(") {
paste0("(", paste0(args, collapse = ", "), ")")
} else {
paste0(fun, "(", paste0(args, collapse = ", "), ")")
}
} else {
x # nocov
}
}
|
