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
|
pluralise_msg <- function(message, objects) {
paste0(
pluralise(message, objects),
format_n(objects)
)
}
pluralise_commas <- function(message, objects, ...) {
paste0(
pluralise_n(message, length(objects)),
commas(objects),
pluralise_n(paste0(...), length(objects))
)
}
pluralise_count <- function(message, count, ...) {
paste0(
pluralise_n(message, count),
count,
pluralise_n(paste0(...), count)
)
}
pluralise <- function(message, objects) {
pluralise_n(message, length(objects))
}
pluralise_n <- function(message, n) {
stopifnot(n >= 0)
# Don't strip parens if they have a space in between
# (but not if the space comes before the closing paren)
if (n == 1) {
# strip [
message <- gsub("\\[([^\\] ]* *)\\]", "\\1", message, perl = TRUE)
# remove ( and its content
message <- gsub("\\([^\\) ]* *\\)", "", message, perl = TRUE)
} else {
# strip (
message <- gsub("\\(([^\\) ]* *)\\)", "\\1", message, perl = TRUE)
# remove [ and its content
message <- gsub("\\[[^\\] ]* *\\]", "", message, perl = TRUE)
}
message
}
bullets <- function(header, ..., info = NULL) {
# FIXME: Convert info to i with rlang >= 0.4.12, use set_default_name(bullets, "*")
# FIXME: Avoid ensure_full_stop()
bullets <- vec_c(..., .name_spec = "{outer}")
paste0(
ensure_full_stop(header), "\n",
format_error_bullets(ensure_full_stop(bullets)),
if (!is.null(info)) paste0("\n", format_error_bullets(c(i = info)))
)
}
problems <- function(header, ..., .problem = " problem(s)") {
problems <- vec_c(..., .name_spec = "{outer}")
problems <- set_default_name(problems, "x")
MAX_BULLETS <- 6L
if (length(problems) >= MAX_BULLETS) {
n_more <- length(problems) - MAX_BULLETS + 1L
problems[[MAX_BULLETS]] <-
pluralise_n(paste0(pre_dots("and "), n_more, " more", .problem), n_more)
length(problems) <- MAX_BULLETS
}
bullets(header, problems)
}
commas <- function(problems) {
MAX_BULLETS <- 6L
n <- length(problems)
if (n <= 1) {
return(problems)
} else if (n == 2) {
return(paste(problems, collapse = " and "))
}
if (n >= MAX_BULLETS) {
n_more <- length(problems) - MAX_BULLETS + 1L
problems[[MAX_BULLETS]] <- paste0(n_more, " more")
length(problems) <- MAX_BULLETS
n <- MAX_BULLETS
}
problems[[n]] <- paste0("and ", problems[[n]])
paste(problems, collapse = ", ")
}
ensure_full_stop <- function(x) {
set_names(gsub("(?::|([^.?]))$", "\\1.", x), names(x))
}
set_default_name <- function(x, name) {
if (is.null(names(x))) {
names(x) <- rep_along(x, name)
} else {
names(x)[names(x) == ""] <- name
}
x
}
|
