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
|
check_between_year <- function(
x,
...,
call = caller_env(),
arg = caller_arg(x)
) {
check_between(
x,
lower = clock_calendar_year_minimum,
upper = clock_calendar_year_maximum,
call = call,
arg = arg
)
}
check_between_quarter <- function(
x,
...,
call = caller_env(),
arg = caller_arg(x)
) {
check_between(x, lower = 1L, upper = 4L, call = call, arg = arg)
}
check_between_month <- function(
x,
...,
call = caller_env(),
arg = caller_arg(x)
) {
check_between(x, lower = 1L, upper = 12L, call = call, arg = arg)
}
check_between_week <- function(
x,
...,
call = caller_env(),
arg = caller_arg(x)
) {
check_between(x, lower = 1L, upper = 53L, call = call, arg = arg)
}
check_between_day_of_year <- function(
x,
...,
call = caller_env(),
arg = caller_arg(x)
) {
check_between(x, lower = 1L, upper = 366L, call = call, arg = arg)
}
check_between_day_of_quarter <- function(
x,
...,
call = caller_env(),
arg = caller_arg(x)
) {
check_between(x, lower = 1L, upper = 92L, call = call, arg = arg)
}
check_between_day_of_month <- function(
x,
...,
call = caller_env(),
arg = caller_arg(x)
) {
check_between(x, lower = 1L, upper = 31L, call = call, arg = arg)
}
check_between_day_of_week <- function(
x,
...,
call = caller_env(),
arg = caller_arg(x)
) {
check_between(x, lower = 1L, upper = 7L, call = call, arg = arg)
}
check_between_index_of_week <- function(
x,
...,
call = caller_env(),
arg = caller_arg(x)
) {
check_between(x, lower = 1L, upper = 5L, call = call, arg = arg)
}
check_between_hour <- function(
x,
...,
call = caller_env(),
arg = caller_arg(x)
) {
check_between(x, lower = 0L, upper = 23L, call = call, arg = arg)
}
check_between_minute <- function(
x,
...,
call = caller_env(),
arg = caller_arg(x)
) {
check_between(x, lower = 0L, upper = 59L, call = call, arg = arg)
}
check_between_second <- function(
x,
...,
call = caller_env(),
arg = caller_arg(x)
) {
check_between(x, lower = 0L, upper = 59L, call = call, arg = arg)
}
check_between_subsecond <- function(
x,
precision,
...,
call = caller_env(),
arg = caller_arg(x)
) {
upper <- switch(
precision_to_string(precision),
millisecond = 999L,
microsecond = 999999L,
nanosecond = 999999999L,
abort("Invalid precision.", .internal = TRUE)
)
check_between(x, lower = 0L, upper = upper, call = call, arg = arg)
}
check_between <- function(
x,
lower,
upper,
...,
call = caller_env(),
arg = caller_arg(x)
) {
ok <- (x >= lower & x <= upper) | vec_detect_missing(x)
if (all(ok)) {
return(invisible(NULL))
}
loc <- which(!ok)
message <- c(
"{.arg {arg}} must be between [{lower}, {upper}].",
i = "Invalid results at locations: {loc}."
)
cli::cli_abort(message, call = call)
}
|
