Introduce cli_menu() and friends

NEWS.md

@@ -1,5 +1,7 @@
 # gargle (development version)
 
+gargle now elicits user input via `readline()`, instead of via `utils::menu()`, which is favorable for interacting with the user in a Jupyter notebook (#242).
+
 The roxygen templating functions that wrapper packages can use to generate standardized documentation around auth have been updated to reflect gargle's pivot from OAuth "app" to "client".
 Changes of note:
 

R/Gargle-class.R

@@ -273,14 +273,13 @@ encourage_httpuv <- function() {
   if (!is_interactive() || isTRUE(is_installed("httpuv"))) {
     return(invisible())
   }
-  local_gargle_verbosity("info")
-  gargle_info(c(
-    "The {.pkg httpuv} package enables a nicer Google auth experience, \\
-     in many cases.",
-    "It doesn't seem to be installed.",
-    "Would you like to install it now?"
-  ))
-  if (utils::menu(c("Yes", "No")) == 1) {
+  choice <- cli_menu(
+   "The {.pkg httpuv} package enables a nicer Google auth experience, in many \\
+    cases, but it isn't installed.",
+    "Would you like to install it now?",
+    choices = c("Yes", "No")
+  )
+  if (choice == 1) {
     utils::install.packages("httpuv")
   }
   invisible()

R/oauth-cache.R

@@ -62,11 +62,13 @@ cache_allowed <- function(path) {
     return(FALSE)
   }
 
-  local_gargle_verbosity("info")
-  gargle_info("
-    Is it OK to cache OAuth access credentials in the folder \\
-    {.path {path}} between R sessions?")
-  utils::menu(c("Yes", "No")) == 1
+  choice <- cli_menu(
+    header = character(),
+    prompt = "Is it OK to cache OAuth access credentials in the folder \\
+              {.path {path}} between R sessions?",
+    choices = c("Yes", "No")
+  )
+  choice == 1
 }
 
 cache_create <- function(path) {
@@ -314,19 +316,20 @@ token_match <- function(candidate, existing, package = "gargle") {
   }
 
   # we need user to OK our discovery or pick from multiple emails
-  emails <- extract_email(existing)
-  local_gargle_verbosity("info")
-  gargle_info(c(
+  choices <- c(
+    "Send me to the browser for a new auth process.",
+    extract_email(existing)
+  )
+  choice <- cli_menu(
     "The {.pkg {package}} package is requesting access to your Google account.",
-    "Select a pre-authorised account or enter '0' to obtain a new token.",
-    "Press Esc/Ctrl + C to cancel."
-  ))
-  choice <- utils::menu(emails)
+    "Enter '1' to start a new auth process or select a pre-authorized account.",
+    choices = choices
+  )
 
-  if (choice == 0) {
+  if (choice == 1) {
     NULL
   } else {
-    existing[[choice]]
+    existing[[choice - 1]]
   }
 }
 

R/utils-ui.R

@@ -250,3 +250,80 @@ compute_n_show <- function(n, n_show_nominal = 5, n_fudge = 2) {
     n
   }
 }
+
+# menu(), but based on readline() + cli and mockable ---------------------------
+# https://github.com/r-lib/cli/issues/228
+# https://github.com/rstudio/rsconnect/blob/main/R/utils-cli.R
+
+cli_menu <- function(header,
+                     prompt,
+                     choices,
+                     not_interactive = choices,
+                     exit = integer(),
+                     .envir = caller_env(),
+                     error_call = caller_env()) {
+  if (!is_interactive()) {
+    cli::cli_abort(
+      c(header, not_interactive),
+      .envir = .envir,
+      call = error_call
+    )
+  }
+
+  choices <- paste0(cli::style_bold(seq_along(choices)), ": ", choices)
+  cli::cli_inform(
+    c(header, prompt, choices),
+    .envir = .envir
+  )
+
+  repeat {
+    selected <- cli_readline("Selection: ")
+    if (selected %in% c("0", seq_along(choices))) {
+      break
+    }
+    cli::cli_inform(
+      "Enter a number between 1 and {length(choices)}, or enter 0 to exit."
+    )
+  }
+
+  selected <- as.integer(selected)
+  if (selected %in% c(0, exit)) {
+    if (is_testing()) {
+      cli::cli_abort("Exiting...", call = NULL)
+    } else {
+      cli::cli_alert_danger("Exiting...")
+      # simulate user pressing Ctrl + C
+      invokeRestart("abort")
+    }
+  }
+
+  selected
+}
+
+cli_readline <- function(prompt) {
+  local_input <- getOption("cli_input", character())
+
+  # not convinced that we need to plan for multiple mocked inputs, but leaving
+  # this feature in for now
+  if (length(local_input) > 0) {
+    input <- local_input[[1]]
+    cli::cli_inform(paste0(prompt, input))
+    options(cli_input = local_input[-1])
+    input
+  } else {
+    readline(prompt)
+  }
+}
+
+local_user_input <- function(x, env = caller_env()) {
+  withr::local_options(
+    rlang_interactive = TRUE,
+    # trailing 0 prevents infinite loop if x only contains invalid choices
+    cli_input = c(x, "0"),
+    .local_envir = env
+  )
+}
+
+is_testing <- function() {
+  identical(Sys.getenv("TESTTHAT"), "true")
+}

tests/testthat/_snaps/utils-ui.md

@@ -148,3 +148,116 @@
       * g
       * h
 
+# cli_menu() basic usage
+
+    Code
+      cli_menu_with_mock(1)
+    Message
+      Found multiple thingies.
+      Which one do you want to use?
+      1: label a
+      2: label b
+      3: label c
+      Selection: 1
+    Output
+      [1] 1
+
+# cli_menu() does not infinite loop with invalid mocked input
+
+    Code
+      cli_menu_with_mock("nope")
+    Message
+      Found multiple thingies.
+      Which one do you want to use?
+      1: label a
+      2: label b
+      3: label c
+      Selection: nope
+      Enter a number between 1 and 3, or enter 0 to exit.
+      Selection: 0
+    Condition
+      Error:
+      ! Exiting...
+
+# cli_menu() can work through multiple valid mocked inputs
+
+    Code
+      out <- cli_menu_with_mock(c(1, 3))
+    Message
+      Found multiple thingies.
+      Which one do you want to use?
+      1: label 1
+      2: label 2
+      3: label 3
+      Selection: 1
+      Found multiple thingies.
+      Which one do you want to use?
+      1: label 1
+      2: label 2
+      3: label 3
+      Selection: 3
+
+# cli_menu(), request exit via 0
+
+    Code
+      cli_menu_with_mock(0)
+    Message
+      Found multiple thingies.
+      Which one do you want to use?
+      1: label a
+      2: label b
+      3: label c
+      Selection: 0
+    Condition
+      Error:
+      ! Exiting...
+
+# cli_menu(exit =) works
+
+    Code
+      cli_menu_with_mock(1)
+    Message
+      Hey we need to talk.
+      What do you want to do?
+      1: Give up
+      2: Some other thing
+      Selection: 1
+    Condition
+      Error:
+      ! Exiting...
+
+---
+
+    Code
+      cli_menu_with_mock(2)
+    Message
+      Hey we need to talk.
+      What do you want to do?
+      1: Give up
+      2: Some other thing
+      Selection: 2
+    Output
+      [1] 2
+
+# cli_menu() inline markup and environment passing
+
+    Code
+      cli_menu_with_mock(1)
+    Message
+      Hey we need to "talk".
+      What do you want to "do"?
+      1: Send email to '[email protected]'
+      2: Install the nifty package
+      Selection: 1
+    Output
+      [1] 1
+
+# cli_menu() not_interactive, many strings, chained error
+
+    Code
+      wrapper_fun()
+    Condition
+      Error in `wrapper_fun()`:
+      ! Multiple things found.
+      i Use `thingy` to specify one of "thing 1", "thing 2", and "thing 3".
+

tests/testthat/test-Gargle-class.R

@@ -25,7 +25,7 @@ test_that("email can be set in option", {
 })
 
 test_that("Attempt to initiate OAuth2 flow fails if non-interactive", {
-  rlang::local_interactive(FALSE)
+  local_interactive(FALSE)
   expect_snapshot(gargle2.0_token(cache = FALSE), error = TRUE)
 })
 

tests/testthat/test-oauth-cache.R

@@ -70,6 +70,7 @@ test_that("default is to consult and set the oauth cache option", {
 # cache_allowed() --------------------------------------------------------------
 
 test_that("cache_allowed() returns false when non-interactive (or testing)", {
+  local_interactive(FALSE)
   expect_false(cache_allowed(getwd()))
 })