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
|
#' Casting
#'
#' Double dispatch methods to support [vctrs::vec_cast()].
#'
#' @inheritParams vctrs::vec_cast
#'
#' @keywords internal
#' @method vec_cast blob
#' @export
#' @export vec_cast.blob
vec_cast.blob <- function(x, to, ...) UseMethod("vec_cast.blob")
#' @method vec_cast.blob default
#' @export
vec_cast.blob.default <- function(x, to, ...) vec_default_cast(x, to, ...)
#' @method vec_cast.blob blob
#' @export
vec_cast.blob.blob <- function(x, to, ...) x
#' @method vec_cast.blob list
#' @export
vec_cast.blob.list <- function(x, to, ...) blob(!!!x)
#' @method vec_cast.blob vctrs_list_of
#' @export
vec_cast.blob.vctrs_list_of <- function(x, to, ...) {
new_blob(vec_cast(x, new_list_of(ptype = raw())))
}
#' @method vec_cast.blob integer
#' @export
vec_cast.blob.integer <- function(x, to, ...) {
signal_soft_deprecated("Coercing an integer vector to a blob is deprecated, please coerce to a list first.")
blob(!!!lapply(x, as_single_raw))
}
#' @method vec_cast.blob raw
#' @export
vec_cast.blob.raw <- function(x, to, ...) blob(x)
#' @method vec_cast.blob character
#' @export
vec_cast.blob.character <- function(x, to, ...) {
out <- as_blob(vector("list", length(x)))
# charToRaw(NA_character_) == charToRaw("NA"), so only convert non-missing entries
non_missing <- !is.na(x)
out[non_missing] <- lapply(x[non_missing], charToRaw)
out
}
|
