1#' Build an error message from parts
2#'
3#' @description
4#'
5#' `cnd_message()` assembles an error message from three generics:
6#'
7#' - `cnd_header()`
8#' - `cnd_body()`
9#' - `cnd_footer()`
10#'
11#' The default method for the error header returns the `message` field
12#' of the condition object. The default methods for the body and
13#' footer return empty character vectors. In general, methods for
14#' these generics should return a character vector. The elements are
15#' combined into a single string with a newline separator.
16#'
17#' `cnd_message()` is automatically called by the `conditionMessage()`
18#' for rlang errors. Error classes created with [abort()] only need to
19#' implement header, body or footer methods. This provides a lot of
20#' flexibility for hierarchies of error classes, for instance you
21#' could inherit the body of an error message from a parent class
22#' while overriding the header and footer.
23#'
24#'
25#' @section Overriding `cnd_body()`:
26#'
27#' \Sexpr[results=rd, stage=render]{rlang:::lifecycle("experimental")}
28#'
29#' Sometimes the contents of an error message depends on the state of
30#' your checking routine. In that case, it can be tricky to lazily
31#' generate error messages with `cnd_body()`: you have the choice
32#' between overspecifying your error class hierarchies with one class
33#' per state, or replicating the type-checking control flow within the
34#' `cnd_body()` method. None of these options are ideal.
35#'
36#' A better option is to define a `body` field in your error object
37#' containing a static string, a [lambda-formula][as_function], or a
38#' function with the same signature as `cnd_body()`. This field
39#' overrides the `cnd_body()` generic and makes it easy to generate an
40#' error message tailored to the state in which the error was
41#' constructed.
42#'
43#' @param cnd A condition object.
44#' @param ... Arguments passed to methods.
45#'
46#' @export
47cnd_message <- function(cnd) {
48  paste_line(
49    cnd_header(cnd),
50    cnd_body(cnd),
51    cnd_footer(cnd)
52  )
53}
54
55#' @rdname cnd_message
56#' @export
57cnd_header <- function(cnd, ...) {
58  UseMethod("cnd_header")
59}
60#' @export
61cnd_header.default <- function(cnd, ...) {
62  cnd$message
63}
64
65#' @rdname cnd_message
66#' @export
67cnd_body <- function(cnd, ...) {
68  if (is_null(cnd$body)) {
69    UseMethod("cnd_body")
70  } else {
71    override_cnd_body(cnd, ...)
72  }
73}
74#' @export
75cnd_body.default <- function(cnd, ...) {
76  chr()
77}
78
79override_cnd_body <- function(cnd, ...) {
80  body <- cnd$body
81
82  if (is_function(body)) {
83    body(cnd, ...)
84  } else if (is_bare_formula(body)) {
85    body <- as_function(body)
86    body(cnd, ...)
87  } else if (is_string(body)) {
88    body
89  } else {
90    abort("`body` must be a string or a function.")
91  }
92}
93
94#' @rdname cnd_message
95#' @export
96cnd_footer <- function(cnd, ...) {
97  UseMethod("cnd_footer")
98}
99#' @export
100cnd_footer.default <- function(cnd, ...) {
101  chr()
102}
103
104#' Format bullets for error messages
105#'
106#' @description
107#'
108#' `format_error_bullets()` takes a character vector and returns a single
109#' string (or an empty vector if the input is empty). The elements of
110#' the input vector are assembled as a list of bullets, depending on
111#' their names:
112#'
113#' - Elements named `"i"` are bulleted with a blue "info" symbol.
114#' - Elements named `"x"` are bulleted with a red "cross" symbol.
115#' - Unnamed elements are bulleted with a "*" symbol.
116#'
117#' This experimental infrastructure is based on the idea that
118#' sentences in error messages are best kept short and simple. From
119#' this point of view, the best way to present the information is in
120#' the [cnd_body()] method of an error conditon, as a bullet list of
121#' simple sentences containing a single clause. The info and cross
122#' symbols of the bullets provide hints on how to interpret the bullet
123#' relative to the general error issue, which should be supplied as
124#' [cnd_header()].
125#'
126#' @param x A named character vector of messages. Elements named as
127#'   `x` or `i` are prefixed with the corresponding bullet.
128#' @export
129format_error_bullets <- function(x) {
130  if (!length(x)) {
131    return(x)
132  }
133
134  nms <- names2(x)
135  stopifnot(nms %in% c("i", "x", ""))
136
137  bullets <- ifelse(nms == "i", info(), ifelse(nms == "x", cross(), "*"))
138  bullets <- paste(bullets, x, collapse = "\n")
139  bullets
140}
141
142collapse_cnd_message <- function(x) {
143  if (length(x) > 1L) {
144    paste(
145      x[[1]],
146      format_error_bullets(x[-1]),
147      sep = "\n"
148    )
149  } else {
150    x
151  }
152}
153