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
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
|
#' Tweaks for DBI tests
#'
#' The tweaks are a way to control the behavior of certain tests. Currently,
#' you need to search the \pkg{DBItest} source code to understand which tests
#' are affected by which tweaks. This function is usually called to set the
#' `tweaks` argument in a [make_context()] call.
#'
#' @name tweaks
#' @aliases NULL
#' @examples
#' \dontrun{
#' make_context(..., tweaks = tweaks(strict_identifier = TRUE))
#' }
{
# nolint
tweak_names <- alist(
#' @param ... `[any]`\cr
#' Unknown tweaks are accepted, with a warning. The ellipsis
#' also makes sure that you only can pass named arguments.
"..." = ,
#' @param constructor_name `[character(1)]`\cr
#' Name of the function that constructs the `Driver` object.
"constructor_name" = NULL,
#' @param constructor_relax_args `[logical(1)]`\cr
#' If `TRUE`, allow a driver constructor with default values for all
#' arguments; otherwise, require a constructor with empty argument list
#' (default).
"constructor_relax_args" = FALSE,
#' @param strict_identifier `[logical(1)]`\cr
#' Set to `TRUE` if the DBMS does not support arbitrarily-named
#' identifiers even when quoting is used.
"strict_identifier" = FALSE,
#' @param omit_blob_tests `[logical(1)]`\cr
#' Set to `TRUE` if the DBMS does not support a `BLOB` data
#' type.
"omit_blob_tests" = FALSE,
#' @param current_needs_parens `[logical(1)]`\cr
#' Set to `TRUE` if the SQL functions `current_date`,
#' `current_time`, and `current_timestamp` require parentheses.
"current_needs_parens" = FALSE,
#' @param union `[function(character)]`\cr
#' Function that combines several subqueries into one so that the
#' resulting query returns the concatenated results of the subqueries
"union" = function(x) paste(x, collapse = " UNION "),
#' @param placeholder_pattern `[character]`\cr
#' A pattern for placeholders used in [dbBind()], e.g.,
#' `"?"`, `"$1"`, or `":name"`. See
#' [make_placeholder_fun()] for details.
"placeholder_pattern" = NULL,
#' @param logical_return `[function(logical)]`\cr
#' A vectorized function that converts logical values to the data type
#' returned by the DBI backend.
"logical_return" = identity,
#' @param date_cast `[function(character)]`\cr
#' A vectorized function that creates an SQL expression for coercing a
#' string to a date value.
"date_cast" = function(x) paste0("date('", x, "')"),
#' @param time_cast `[function(character)]`\cr
#' A vectorized function that creates an SQL expression for coercing a
#' string to a time value.
"time_cast" = function(x) paste0("time('", x, "')"),
#' @param timestamp_cast `[function(character)]`\cr
#' A vectorized function that creates an SQL expression for coercing a
#' string to a timestamp value.
"timestamp_cast" = function(x) paste0("timestamp('", x, "')"),
#' @param blob_cast `[function(character)]`\cr
#' A vectorized function that creates an SQL expression for coercing a
#' string to a blob value.
"blob_cast" = identity,
#' @param date_typed `[logical(1L)]`\cr
#' Set to `FALSE` if the DBMS doesn't support a dedicated type for dates.
"date_typed" = TRUE,
#' @param time_typed `[logical(1L)]`\cr
#' Set to `FALSE` if the DBMS doesn't support a dedicated type for times.
"time_typed" = TRUE,
#' @param timestamp_typed `[logical(1L)]`\cr
#' Set to `FALSE` if the DBMS doesn't support a dedicated type for
#' timestamps.
"timestamp_typed" = TRUE,
#' @param temporary_tables `[logical(1L)]`\cr
#' Set to `FALSE` if the DBMS doesn't support temporary tables.
"temporary_tables" = TRUE,
#' @param list_temporary_tables `[logical(1L)]`\cr
#' Set to `FALSE` if the DBMS doesn't support listing temporary tables.
"list_temporary_tables" = TRUE,
#' @param allow_na_rows_affected `[logical(1L)]`\cr
#' Set to `TRUE` to allow [dbGetRowsAffected()] to return `NA`.
"allow_na_rows_affected" = FALSE,
#' @param is_null_check `[function(character)]`\cr
#' A vectorized function that creates an SQL expression for checking if a
#' value is `NULL`.
"is_null_check" = function(x) paste0("(", x, " IS NULL)"),
#' @param create_table_as `[function(character(1), character(1))]`\cr
#' A function that creates an SQL expression for creating a table
#' from an SQL expression.
"create_table_as" = function(table_name, query) paste0("CREATE TABLE ", table_name, " AS ", query),
#' @param dbitest_version `[character(1)]`\cr
#' Compatible DBItest version, default: "1.7.1".
"dbitest_version" = "1.7.1",
# Dummy argument
NULL
)
}
# A helper function that constructs the tweaks() function in a DRY fashion.
make_tweaks <- function(envir = parent.frame()) {
fmls <- tweak_names[-length(tweak_names)]
tweak_quoted <- map(setNames(nm = names(fmls)), as.name)
tweak_quoted <- c(tweak_quoted)
list_call <- as.call(c(quote(list), tweak_quoted[-1]))
fun <- eval(bquote(
function() {
unknown <- list(...)
if (length(unknown) > 0) {
if (is.null(names(unknown)) || any(names(unknown) == "")) {
warning("All tweaks must be named", call. = FALSE)
} else {
warning("Unknown tweaks: ", paste(names(unknown), collapse = ", "),
call. = FALSE
)
}
}
ret <- .(list_call)
ret <- compact(ret)
structure(ret, class = "DBItest_tweaks")
},
as.environment(list(list_call = list_call))
))
formals(fun) <- fmls
environment(fun) <- envir
fun
}
#' @export
#' @rdname tweaks
tweaks <- make_tweaks()
#' @export
format.DBItest_tweaks <- function(x, ...) {
if (length(x) == 0L) {
return("DBItest tweaks: Empty")
}
c(
"DBItest tweaks:",
unlist(mapply(
function(name, value) {
paste0(" ", name, ": ", format(value)[[1]])
},
names(x), unclass(x)
))
)
}
#' @export
print.DBItest_tweaks <- function(x, ...) {
cat(format(x), sep = "\n")
}
#' @export
`$.DBItest_tweaks` <- function(x, tweak) {
if (!(tweak %in% names(tweak_names))) {
stop("Tweak not found: ", tweak, call. = FALSE)
}
NextMethod()
}
|
