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
|
#' @export
format.blob <- function(x, ...) {
if (length(x) == 0)
return(character())
ifelse(is.na(x), "<NA>", paste0("blob[", blob_size(x, ...), "]"))
}
#' @export
obj_print_data.blob <- function(x, ...) {
if (length(x) == 0)
return()
out <- stats::setNames(format(x), names(x))
print(out, quote = FALSE)
invisible(x)
}
#' @export
vec_ptype_abbr.blob <- function(x, ..., prefix_named, suffix_shape) {
"blob"
}
#' @export
vec_ptype_full.blob <- function(x, ...) {
"blob"
}
blob_size <- function(x, digits = 3, trim = TRUE, ...) {
x <- vapply(x, length, numeric(1))
if (isTRUE(trim)) {
pretty_bytes_nopad(x)
} else {
pretty_bytes_default(x)
}
}
# Dynamically exported, see zzz.R
pillar_shaft.blob <- function(x, ...) {
out <- ifelse(
is.na(x),
NA_character_,
paste0(pillar::style_subtle("<raw "), blob_size(x, ...), pillar::style_subtle(">"))
)
pillar::new_pillar_shaft_simple(out, align = "right")
}
|
