1#' User interface
2#'
3#' @description
4#' These functions are used to construct the user interface of usethis. Use
5#' them in your own package so that your `use_` functions work the same way
6#' as usethis.
7#'
8#' The `ui_` functions can be broken down into four main categories:
9#'
10#' * block styles: `ui_line()`, `ui_done()`, `ui_todo()`, `ui_oops()`,
11#'   `ui_info()`.
12#' * conditions: `ui_stop()`, `ui_warn()`.
13#' * questions: [ui_yeah()], [ui_nope()].
14#' * inline styles: `ui_field()`, `ui_value()`, `ui_path()`, `ui_code()`,
15#'   `ui_unset()`.
16#'
17#' The question functions [ui_yeah()] and [ui_nope()] have their own [help
18#' page][ui-questions].
19#'
20#' @section Silencing output:
21#' All UI output (apart from `ui_yeah()`/`ui_nope()` prompts) can be silenced
22#' by setting `options(usethis.quiet = TRUE)`. Use `ui_silence()` to silence
23#' selected actions.
24#'
25#' @param x A character vector.
26#'
27#'   For block styles, conditions, and questions, each element of the
28#'   vector becomes a line, and the result is processed by [glue::glue()].
29#'   For inline styles, each element of the vector becomes an entry in a
30#'   comma separated list.
31#' @param .envir Used to ensure that [glue::glue()] gets the correct
32#'   environment. For expert use only.
33#'
34#' @return The block styles, conditions, and questions are called for their
35#'   side-effect. The inline styles return a string.
36#' @keywords internal
37#' @family user interface functions
38#' @name ui
39#' @examples
40#' new_val <- "oxnard"
41#' ui_done("{ui_field('name')} set to {ui_value(new_val)}")
42#' ui_todo("Redocument with {ui_code('devtools::document()')}")
43#'
44#' ui_code_block(c(
45#'   "Line 1",
46#'   "Line 2",
47#'   "Line 3"
48#' ))
49NULL
50
51# Block styles ------------------------------------------------------------
52
53#' @rdname ui
54#' @export
55ui_line <- function(x = character(), .envir = parent.frame()) {
56  x <- glue_collapse(x, "\n")
57  x <- glue(x, .envir = .envir)
58  ui_inform(x)
59}
60
61#' @rdname ui
62#' @export
63ui_todo <- function(x, .envir = parent.frame()) {
64  x <- glue_collapse(x, "\n")
65  x <- glue(x, .envir = .envir)
66  ui_bullet(x, crayon::red(cli::symbol$bullet))
67}
68
69#' @rdname ui
70#' @export
71ui_done <- function(x, .envir = parent.frame()) {
72  x <- glue_collapse(x, "\n")
73  x <- glue(x, .envir = .envir)
74  ui_bullet(x, crayon::green(cli::symbol$tick))
75}
76
77#' @rdname ui
78#' @export
79ui_oops <- function(x, .envir = parent.frame()) {
80  x <- glue_collapse(x, "\n")
81  x <- glue(x, .envir = .envir)
82  ui_bullet(x, crayon::red(cli::symbol$cross))
83}
84
85#' @rdname ui
86#' @export
87ui_info <- function(x, .envir = parent.frame()) {
88  x <- glue_collapse(x, "\n")
89  x <- glue(x, .envir = .envir)
90  ui_bullet(x, crayon::yellow(cli::symbol$info))
91}
92
93#' @param copy If `TRUE`, the session is interactive, and the clipr package
94#'   is installed, will copy the code block to the clipboard.
95#' @rdname ui
96#' @export
97ui_code_block <- function(x,
98                          copy = rlang::is_interactive(),
99                          .envir = parent.frame()) {
100  x <- glue_collapse(x, "\n")
101  x <- glue(x, .envir = .envir)
102
103  block <- indent(x, "  ")
104  block <- crayon::silver(block)
105  ui_inform(block)
106
107  if (copy && clipr::clipr_available()) {
108    x <- crayon::strip_style(x)
109    clipr::write_clip(x)
110    ui_inform("  [Copied to clipboard]")
111  }
112}
113
114# Conditions --------------------------------------------------------------
115
116#' @rdname ui
117#' @export
118ui_stop <- function(x, .envir = parent.frame()) {
119  x <- glue_collapse(x, "\n")
120  x <- glue(x, .envir = .envir)
121
122  cnd <- structure(
123    class = c("usethis_error", "error", "condition"),
124    list(message = x)
125  )
126
127  stop(cnd)
128}
129
130#' @rdname ui
131#' @export
132ui_warn <- function(x, .envir = parent.frame()) {
133  x <- glue_collapse(x, "\n")
134  x <- glue(x, .envir = .envir)
135
136  warning(x, call. = FALSE, immediate. = TRUE)
137}
138
139
140# Silence -----------------------------------------------------------------
141
142#' @rdname ui
143#' @param code Code to execute with usual UI output silenced.
144#' @export
145ui_silence <- function(code) {
146  withr::with_options(list(usethis.quiet = TRUE), code)
147}
148
149# Questions ---------------------------------------------------------------
150
151#' User interface - Questions
152#'
153#' These functions are used to interact with the user by posing a simple yes or
154#' no question. For details on the other `ui_*()` functions, see the [ui] help
155#' page.
156#'
157#' @inheritParams ui
158#' @param yes A character vector of "yes" strings, which are randomly sampled to
159#'   populate the menu.
160#' @param no A character vector of "no" strings, which are randomly sampled to
161#'   populate the menu.
162#' @param n_yes An integer. The number of "yes" strings to include.
163#' @param n_no An integer. The number of "no" strings to include.
164#' @param shuffle A logical. Should the order of the menu options be randomly
165#'   shuffled?
166#'
167#' @return A logical. `ui_yeah()` returns `TRUE` when the user selects a "yes"
168#'   option and `FALSE` otherwise, i.e. when user selects a "no" option or
169#'   refuses to make a selection (cancels). `ui_nope()` is the logical opposite
170#'   of `ui_yeah()`.
171#' @name ui-questions
172#' @keywords internal
173#' @family user interface functions
174#' @examples
175#' \dontrun{
176#' ui_yeah("Do you like R?")
177#' ui_nope("Have you tried turning it off and on again?", n_yes = 1, n_no = 1)
178#' ui_yeah("Are you sure its plugged in?", yes = "Yes", no = "No", shuffle = FALSE)
179#' }
180NULL
181
182#' @rdname ui-questions
183#' @export
184ui_yeah <- function(x,
185                    yes = c("Yes", "Definitely", "For sure", "Yup", "Yeah", "I agree", "Absolutely"),
186                    no = c("No way", "Not now", "Negative", "No", "Nope", "Absolutely not"),
187                    n_yes = 1, n_no = 2, shuffle = TRUE,
188                    .envir = parent.frame()) {
189  x <- glue_collapse(x, "\n")
190  x <- glue(x, .envir = .envir)
191
192  if (!is_interactive()) {
193    ui_stop(c(
194      "User input required, but session is not interactive.",
195      "Query: {x}"
196    ))
197  }
198
199  n_yes <- min(n_yes, length(yes))
200  n_no <- min(n_no, length(no))
201
202  qs <- c(sample(yes, n_yes), sample(no, n_no))
203
204  if (shuffle) {
205    qs <- sample(qs)
206  }
207
208  # TODO: should this be ui_inform()?
209  rlang::inform(x)
210  out <- utils::menu(qs)
211  out != 0L && qs[[out]] %in% yes
212}
213
214#' @rdname ui-questions
215#' @export
216ui_nope <- function(x,
217                    yes = c("Yes", "Definitely", "For sure", "Yup", "Yeah", "I agree", "Absolutely"),
218                    no = c("No way", "Not now", "Negative", "No", "Nope", "Absolutely not"),
219                    n_yes = 1, n_no = 2, shuffle = TRUE,
220                    .envir = parent.frame()) {
221  # TODO(jennybc): is this correct in the case of no selection / cancelling?
222  !ui_yeah(
223    x = x, yes = yes, no = no,
224    n_yes = n_yes, n_no = n_no,
225    shuffle = shuffle,
226    .envir = .envir
227  )
228}
229
230# Inline styles -----------------------------------------------------------
231
232#' @rdname ui
233#' @export
234ui_field <- function(x) {
235  x <- crayon::green(x)
236  x <- glue_collapse(x, sep = ", ")
237  x
238}
239
240#' @rdname ui
241#' @export
242ui_value <- function(x) {
243  if (is.character(x)) {
244    x <- encodeString(x, quote = "'")
245  }
246  x <- crayon::blue(x)
247  x <- glue_collapse(x, sep = ", ")
248  x
249}
250
251#' @rdname ui
252#' @export
253#' @param base If specified, paths will be displayed relative to this path.
254ui_path <- function(x, base = NULL) {
255  is_directory <- is_dir(x) | grepl("/$", x)
256  if (is.null(base)) {
257    x <- proj_rel_path(x)
258  } else if (!identical(base, NA)) {
259    x <- path_rel(x, base)
260  }
261
262  # rationalize trailing slashes
263  x <- path_tidy(x)
264  x <- ifelse(is_directory, paste0(x, "/"), x)
265
266  ui_value(x)
267}
268
269#' @rdname ui
270#' @export
271ui_code <- function(x) {
272  x <- encodeString(x, quote = "`")
273  x <- crayon::silver(x)
274  x <- glue_collapse(x, sep = ", ")
275  x
276}
277
278#' @rdname ui
279#' @export
280ui_unset <- function(x = "unset") {
281  stopifnot(length(x) == 1)
282  x <- glue("<{x}>")
283  x <- crayon::silver(x)
284  x
285}
286
287# rlang::inform() wrappers -----------------------------------------------------
288
289indent <- function(x, first = "  ", indent = first) {
290  x <- gsub("\n", paste0("\n", indent), x)
291  paste0(first, x)
292}
293
294ui_bullet <- function(x, bullet = cli::symbol$bullet) {
295  bullet <- paste0(bullet, " ")
296  x <- indent(x, bullet, "  ")
297  ui_inform(x)
298}
299
300# All UI output must eventually go through ui_inform() so that it
301# can be quieted with 'usethis.quiet' when needed.
302ui_inform <- function(..., quiet = getOption("usethis.quiet", default = FALSE)) {
303  if (!quiet) {
304    inform(paste0(...))
305  }
306
307  invisible()
308}
309
310# Sitrep helpers ---------------------------------------------------------------
311
312hd_line <- function(name) {
313  ui_inform(crayon::bold(name))
314}
315
316kv_line <- function(key, value, .envir = parent.frame()) {
317  value <- if (is.null(value)) ui_unset() else ui_value(value)
318  key <- glue(key, .envir = .envir)
319  ui_inform(glue("{cli::symbol$bullet} {key}: {value}"))
320}
321