-
Notifications
You must be signed in to change notification settings - Fork 10
/
yml_replace.R
87 lines (78 loc) · 1.9 KB
/
yml_replace.R
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
#' Replace, pluck, or discard top-level YAML fields
#'
#' `yml_replace()` replaces a named field with another value. As opposed to
#' duplicating top-level fields with other functions, explicitly replacing them
#' with `yml_replace()` will not raise a warning. `yml_discard()` removes values
#' given either a character vector of names or a purrr-style lambda with a
#' predicate (~ predicate); see the examples. `yml_pluck()` and `yml_chuck()`
#' are wrappers around [purrr::pluck()] and [purrr::chuck()] that return `yml`
#' objects.
#'
#' @template describe_yml_param
#' @param .rid a character vector of fields to remove or a purrr-style lambda
#' with a predicate (~ predicate) where fields that are `TRUE` will be
#' discarded
#' @template describe_dots_param
#'
#' @template describe_yml_output
#' @export
#'
#' @examples
#'\donttest{
#' yml() %>%
#' yml_clean(TRUE) %>%
#' yml_replace(clean = FALSE) %>%
#' yml_discard("author")
#'
#' yml() %>%
#' yml_output(
#' pdf_document(),
#' html_document()
#' )%>%
#' yml_discard(~ length(.x) > 1)
#'}
#'
yml_replace <- function(.yml, ...) {
new <- list(...)
.yml[names(new)] <- new
.yml
}
#' @export
#' @rdname yml_replace
yml_discard <- function(.yml, .rid) {
if (is.character(.rid)) {
return(
.yml[names(.yml) %nin% .rid] %>%
as_yml()
)
}
if (is.numeric(.rid)) {
return(
.yml[-.rid] %>%
as_yml()
)
}
if (rlang::is_formula(.rid)) {
return(
purrr::discard(.yml, .rid) %>%
as_yml()
)
}
msg <- glue::glue(
"`.rid` must be a character vector of field names \\
or a formula specifying a predicate"
)
stop(msg, call. = FALSE)
}
#' @export
#' @rdname yml_replace
yml_pluck <- function(.yml, ...) {
purrr::pluck(.yml, ..., .default = list()) %>%
as_yml()
}
#' @export
#' @rdname yml_replace
yml_chuck <- function(.yml, ...) {
purrr::chuck(.yml, ...) %>%
as_yml()
}