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
|
vectbl_names2 <- function(x,
.name_repair = c("check_unique", "unique", "universal", "minimal"),
quiet = FALSE) {
name <- vec_names2(x, repair = "minimal", quiet = quiet)
repaired_names(name, repair_hint = TRUE, .name_repair = .name_repair, quiet = quiet)
}
set_repaired_names <- function(x,
repair_hint,
.name_repair = c("check_unique", "unique", "universal", "minimal"),
quiet = FALSE) {
set_names(x, repaired_names(names2(x), repair_hint, .name_repair = .name_repair, quiet = quiet))
}
repaired_names <- function(name,
repair_hint,
.name_repair = c("check_unique", "unique", "universal", "minimal"),
quiet = FALSE,
details = NULL) {
subclass_name_repair_errors(
name = name, details = details, repair_hint = repair_hint,
vec_as_names(name, repair = .name_repair, quiet = quiet || !is_character(.name_repair))
)
}
# Errors ------------------------------------------------------------------
error_column_names_cannot_be_empty <- function(names, repair_hint, parent = NULL) {
tibble_error(invalid_df("must be named", names, use_repair(repair_hint)), names = names, parent = parent)
}
error_column_names_cannot_be_dot_dot <- function(names, repair_hint, parent = NULL) {
tibble_error(invalid_df("must not have names of the form ... or ..j", names, use_repair(repair_hint)), names = names, parent = parent)
}
error_column_names_must_be_unique <- function(names, repair_hint, parent = NULL) {
tibble_error(pluralise_commas("Column name(s) ", tick(names), " must not be duplicated.", use_repair(repair_hint)), names = names, parent = parent)
}
# Subclassing errors ------------------------------------------------------
subclass_name_repair_errors <- function(expr, name, details = NULL, repair_hint = FALSE) {
withCallingHandlers(
expr,
# FIXME: use cnd$names with vctrs >= 0.3.0
vctrs_error_names_cannot_be_empty = function(cnd) {
cnd <- error_column_names_cannot_be_empty(detect_empty_names(name), parent = cnd, repair_hint = repair_hint)
cnd$body <- details
cnd_signal(cnd)
},
vctrs_error_names_cannot_be_dot_dot = function(cnd) {
cnd <- error_column_names_cannot_be_dot_dot(detect_dot_dot(name), parent = cnd, repair_hint = repair_hint)
cnd_signal(cnd)
},
vctrs_error_names_must_be_unique = function(cnd) {
cnd <- error_column_names_must_be_unique(detect_duplicates(name), parent = cnd, repair_hint = repair_hint)
cnd_signal(cnd)
}
)
}
# Anticipate vctrs 0.3.0 release: locations replaced by names
detect_empty_names <- function(names) {
which(names == "")
}
detect_dot_dot <- function(names) {
grep("^[.][.](?:[.]|[1-9][0-9]*)$", names)
}
detect_duplicates <- function(names) {
names[which(duplicated(names))]
}
|
