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
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
|
#' Lazy operations
#'
#' This set of S3 classes describe the action of dplyr verbs. These are
#' currently used for SQL sources to separate the description of operations
#' in R from their computation in SQL. This API is very new so is likely
#' to evolve in the future.
#'
#' `op_vars()` and `op_grps()` compute the variables and groups from
#' a sequence of lazy operations. `op_sort()` and `op_frame()` tracks the
#' order and frame for use in window functions.
#'
#' @keywords internal
#' @name lazy_ops
NULL
# Base constructors -------------------------------------------------------
#' @export
#' @rdname lazy_ops
lazy_base_query <- function(x, vars, class = character(), ...) {
check_character(vars)
lazy_query(
query_type = c(paste0("base_", class), "base"),
x = x,
vars = vars,
...,
group_vars = character(),
order_vars = NULL,
frame = NULL
)
}
lazy_query_remote <- function(x, vars) {
lazy_base_query(x, vars, class = "remote")
}
base_query <- function(from) {
check_table_source(from)
structure(
list(from = from),
class = c("base_query", "query")
)
}
#' @export
print.lazy_base_remote_query <- function(x, ...) {
if (is_table_path(x$x)) {
cat_line("From: ", format(x$x))
} else {
cat_line("From: <derived table>")
}
}
#' @export
print.lazy_base_local_query <- function(x, ...) {
cat_line("<Local data frame> ", dplyr::dim_desc(x$x))
}
#' @export
print.base_query <- function(x, ...) {
print(x$from)
}
#' @export
sql_build.lazy_base_remote_query <- function(op, con, ...) {
base_query(op$x)
}
#' @export
sql_build.lazy_base_local_query <- function(op, con, ...) {
base_query(op$name)
}
#' @export
sql_render.base_query <- function(query,
con = NULL,
...,
sql_options = NULL,
subquery = FALSE,
lvl = 0) {
from <- query$from
if (subquery || is.sql(from)) {
from
} else {
from <- escape(from, con = con)
dbplyr_query_select(con, sql("*"), from, lvl = lvl)
}
}
#' @export
flatten_query.base_query <- function(qry, query_list, con) {
query_list
}
# op_grps -----------------------------------------------------------------
#' @export
#' @rdname lazy_ops
op_grps <- function(op) UseMethod("op_grps")
#' @export
op_grps.tbl_lazy <- function(op) op_grps(op$lazy_query)
#' @export
op_grps.lazy_query <- function(op) op$group_vars %||% character()
# op_vars -----------------------------------------------------------------
#' @export
#' @rdname lazy_ops
op_vars <- function(op) UseMethod("op_vars")
#' @export
op_vars.tbl_lazy <- function(op) op_vars(op$lazy_query)
#' @export
op_vars.lazy_base_query <- function(op) op$vars
# op_sort -----------------------------------------------------------------
#' @export
#' @rdname lazy_ops
op_sort <- function(op) UseMethod("op_sort")
#' @export
op_sort.tbl_lazy <- function(op) op_sort(op$lazy_query)
#' @export
op_sort.lazy_query <- function(op) {
# Renaming (like for groups) cannot be done because:
# * `order_vars` is a list of quosures
# * variables needed in sorting can be dropped
op$order_vars
}
# op_frame ----------------------------------------------------------------
#' @export
#' @rdname lazy_ops
op_frame <- function(op) UseMethod("op_frame")
#' @export
op_frame.tbl_lazy <- function(op) op_frame(op$lazy_query)
#' @export
op_frame.lazy_query <- function(op) op$frame
# Description -------------------------------------------------------------
op_rows <- function(op, rows_total = NA_integer_) {
if (is.na(rows_total)) {
"??"
} else {
big_mark(rows_total)
}
}
op_cols <- function(op) {
length(op_vars(op))
}
op_desc <- function(op) UseMethod("op_desc")
#' @export
op_desc.lazy_query <- function(op) {
"SQL"
}
#' @export
op_desc.lazy_base_remote_query <- function(op) {
table <- remote_name(op)
if (is.null(table)) {
"SQL"
} else {
paste0("table<", table, ">")
}
}
|
