Skip to content

Commit d71badd

Browse files
gaborcsardigaborcsardi
committed
Better error, pass down relevant call
1 parent a1d747a commit d71badd

2 files changed

Lines changed: 75 additions & 39 deletions

File tree

‎R/cli.R‎

Lines changed: 57 additions & 27 deletions
Original file line numberDiff line numberDiff line change
@@ -198,7 +198,7 @@ format_inline <- function(..., .envir = parent.frame(), collapse = TRUE) {
198198
#' @export
199199

200200
cli_text <- function(..., .envir = parent.frame()) {
201-
cli__message("text", list(text = glue_cmd(..., .envir = .envir)))
201+
cli__message("text", list(text = glue_cmd(..., .envir = .envir, .call = sys.call())))
202202
}
203203

204204
#' CLI verbatim text
@@ -256,24 +256,42 @@ cli_verbatim <- function(..., .envir = parent.frame()) {
256256
#' @export
257257

258258
cli_h1 <- function(text, id = NULL, class = NULL, .envir = parent.frame()) {
259-
cli__message("h1", list(text = glue_cmd(text, .envir = .envir), id = id,
260-
class = class))
259+
cli__message(
260+
"h1",
261+
list(
262+
text = glue_cmd(text, .envir = .envir, .call = sys.call()),
263+
id = id,
264+
class = class
265+
)
266+
)
261267
}
262268

263269
#' @rdname cli_h1
264270
#' @export
265271

266272
cli_h2 <- function(text, id = NULL, class = NULL, .envir = parent.frame()) {
267-
cli__message("h2", list(text = glue_cmd(text, .envir = .envir), id = id,
268-
class = class))
273+
cli__message(
274+
"h2",
275+
list(
276+
text = glue_cmd(text, .envir = .envir, .call = sys.call()),
277+
id = id,
278+
class = class
279+
)
280+
)
269281
}
270282

271283
#' @rdname cli_h1
272284
#' @export
273285

274286
cli_h3 <- function(text, id = NULL, class = NULL, .envir = parent.frame()) {
275-
cli__message("h3", list(text = glue_cmd(text, .envir = .envir), id = id,
276-
class = class))
287+
cli__message(
288+
"h3",
289+
list(
290+
text = glue_cmd(text, .envir = .envir, .call = sys.call()),
291+
id = id,
292+
class = class
293+
)
294+
)
277295
}
278296

279297
#' Generic CLI container
@@ -468,9 +486,13 @@ cli_ul <- function(items = NULL, id = NULL, class = NULL,
468486
cli__message(
469487
"ul",
470488
list(
471-
items = lapply(items, glue_cmd, .envir = .envir), id = id,
472-
class = class, .close = .close),
473-
.auto_close = .auto_close, .envir = .envir)
489+
items = lapply(items, glue_cmd, .envir = .envir, .call = sys.call()),
490+
id = id,
491+
class = class,
492+
.close = .close
493+
),
494+
.auto_close = .auto_close, .envir = .envir
495+
)
474496
}
475497

476498
#' Ordered CLI list
@@ -528,9 +550,13 @@ cli_ol <- function(items = NULL, id = NULL, class = NULL,
528550
cli__message(
529551
"ol",
530552
list(
531-
items = lapply(items, glue_cmd, .envir = .envir), id = id,
532-
class = class, .close = .close),
533-
.auto_close = .auto_close, .envir = .envir)
553+
items = lapply(items, glue_cmd, .envir = .envir, .call = sys.call()),
554+
id = id,
555+
class = class,
556+
.close = .close
557+
),
558+
.auto_close = .auto_close, .envir = .envir
559+
)
534560
}
535561

536562
#' Definition list
@@ -581,8 +607,10 @@ cli_dl <- function(items = NULL, labels = names(items), id = NULL,
581607
cli__message(
582608
"dl",
583609
list(
584-
items = lapply(items, glue_cmd, .envir = .envir),
585-
labels = if (!is.null(labels)) lapply(labels, glue_cmd, .envir = .envir),
610+
items = lapply(items, glue_cmd, .envir = .envir, .call = sys.call()),
611+
labels = if (!is.null(labels)) {
612+
lapply(labels, glue_cmd, .envir = .envir, .call = sys.call())
613+
},
586614
id = id,
587615
class = class, .close = .close),
588616
.auto_close = .auto_close, .envir = .envir)
@@ -625,8 +653,10 @@ cli_li <- function(items = NULL, labels = names(items), id = NULL,
625653
cli__message(
626654
"li",
627655
list(
628-
items = lapply(items, glue_cmd, .envir = .envir),
629-
labels = if (!is.null(labels)) lapply(labels, glue_cmd, .envir = .envir),
656+
items = lapply(items, glue_cmd, .envir = .envir, .call = sys.call()),
657+
labels = if (!is.null(labels)) {
658+
lapply(labels, glue_cmd, .envir = .envir, .call = sys.call())
659+
},
630660
id = id,
631661
class = class),
632662
.auto_close = .auto_close, .envir = .envir)
@@ -689,7 +719,7 @@ cli_alert <- function(text, id = NULL, class = NULL, wrap = FALSE,
689719
cli__message(
690720
"alert",
691721
list(
692-
text = glue_cmd(text, .envir = .envir),
722+
text = glue_cmd(text, .envir = .envir, .call = sys.call()),
693723
id = id,
694724
class = class,
695725
wrap = wrap
@@ -705,7 +735,7 @@ cli_alert_success <- function(text, id = NULL, class = NULL, wrap = FALSE,
705735
cli__message(
706736
"alert_success",
707737
list(
708-
text = glue_cmd(text, .envir = .envir),
738+
text = glue_cmd(text, .envir = .envir, .call = sys.call()),
709739
id = id,
710740
class = class,
711741
wrap = wrap
@@ -721,7 +751,7 @@ cli_alert_danger <- function(text, id = NULL, class = NULL, wrap = FALSE,
721751
cli__message(
722752
"alert_danger",
723753
list(
724-
text = glue_cmd(text, .envir = .envir),
754+
text = glue_cmd(text, .envir = .envir, .call = sys.call()),
725755
id = id,
726756
class = class,
727757
wrap = wrap
@@ -737,7 +767,7 @@ cli_alert_warning <- function(text, id = NULL, class = NULL, wrap = FALSE,
737767
cli__message(
738768
"alert_warning",
739769
list(
740-
text = glue_cmd(text, .envir = .envir),
770+
text = glue_cmd(text, .envir = .envir, .call = sys.call()),
741771
id = id,
742772
class = class,
743773
wrap = wrap
@@ -753,7 +783,7 @@ cli_alert_info <- function(text, id = NULL, class = NULL, wrap = FALSE,
753783
cli__message(
754784
"alert_info",
755785
list(
756-
text = glue_cmd(text, .envir = .envir),
786+
text = glue_cmd(text, .envir = .envir, .call = sys.call()),
757787
id = id,
758788
class = class,
759789
wrap = wrap
@@ -801,9 +831,9 @@ cli_alert_info <- function(text, id = NULL, class = NULL, wrap = FALSE,
801831

802832
cli_rule <- function(left = "", center = "", right = "", id = NULL,
803833
.envir = parent.frame()) {
804-
cli__message("rule", list(left = glue_cmd(left, .envir = .envir),
805-
center = glue_cmd(center, .envir = .envir),
806-
right = glue_cmd(right, .envir = .envir),
834+
cli__message("rule", list(left = glue_cmd(left, .envir = .envir, .call = sys.call()),
835+
center = glue_cmd(center, .envir = .envir, .call = sys.call()),
836+
right = glue_cmd(right, .envir = .envir, .call = sys.call()),
807837
id = id))
808838
}
809839

@@ -833,8 +863,8 @@ cli_blockquote <- function(quote, citation = NULL, id = NULL,
833863
cli__message(
834864
"blockquote",
835865
list(
836-
quote = glue_cmd(quote, .envir = .envir),
837-
citation = glue_cmd(citation, .envir = .envir),
866+
quote = glue_cmd(quote, .envir = .envir, .call = sys.call()),
867+
citation = glue_cmd(citation, .envir = .envir, .call = sys.call()),
838868
id = id,
839869
class = class
840870
)

‎R/inline.R‎

Lines changed: 18 additions & 12 deletions
Original file line numberDiff line numberDiff line change
@@ -239,7 +239,7 @@ clii__inline <- function(app, text, .list) {
239239

240240
inline_regex <- function() "(?s)^[.]([-[:alnum:]_]+)[[:space:]]+(.*)"
241241

242-
make_cmd_transformer <- function(values) {
242+
make_cmd_transformer <- function(values, .call = NULL) {
243243
values$marker <- random_id()
244244
values$qty <- NA_integer_
245245
values$num_subst <- 0L
@@ -257,6 +257,10 @@ make_cmd_transformer <- function(values) {
257257
".sym_flip(bool_word)", ".sym_flip(bool_topic)", ".sym_flip(bool_wsi)"
258258
)
259259

260+
# it is not easy to do better than this, we would need to pass a call
261+
# down from the exported functions
262+
263+
caller <- .call %||% sys.call(-1)
260264
function(code, envir) {
261265
first_char <- substr(code, 1, 1)
262266

@@ -270,7 +274,7 @@ make_cmd_transformer <- function(values) {
270274
has_match <- m != -1
271275
if (!has_match) {
272276
throw(cli_error(
273-
call. = sys.call(-3),
277+
call. = caller,
274278
"Invalid cli literal: {.code {{{abbrev(code, 10)}}}} starts with a dot.",
275279
"i" = "Interpreted literals must not start with a dot in cli >= 3.4.0.",
276280
"i" = paste("{.code {{}}} expressions starting with a dot are",
@@ -298,15 +302,17 @@ make_cmd_transformer <- function(values) {
298302
# {} plain substitution
299303
} else {
300304
expr <- parse(text = code, keep.source = FALSE) %??%
301-
cli_error(paste(
302-
"Could not parse cli {.code {{}}} expression:",
303-
"{.code {abbrev(code, 20)}}."
304-
))
305+
cli_error(
306+
call. = caller,
307+
"Could not parse cli {.code {{}}} expression:
308+
{.code {abbrev(code, 20)}}."
309+
)
305310
res <- eval(expr, envir = envir) %??%
306-
cli_error(paste(
307-
"Could not evaluate cli {.code {{}}} expression:",
308-
"{.code {abbrev(code, 20)}}."
309-
))
311+
cli_error(
312+
call. = caller,
313+
"Could not evaluate cli {.code {{}}} expression:
314+
{.code {abbrev(code, 20)}}."
315+
)
310316

311317
id <- paste0("v", length(values))
312318
values[[id]] <- res
@@ -317,10 +323,10 @@ make_cmd_transformer <- function(values) {
317323
}
318324
}
319325

320-
glue_cmd <- function(..., .envir) {
326+
glue_cmd <- function(..., .envir, .call = sys.call(-1)) {
321327
str <- paste0(unlist(list(...), use.names = FALSE), collapse = "")
322328
values <- new.env(parent = emptyenv())
323-
transformer <- make_cmd_transformer(values)
329+
transformer <- make_cmd_transformer(values, .call = .call)
324330
pstr <- glue(
325331
str,
326332
.envir = .envir,

0 commit comments

Comments
 (0)