Nothing
#' Provide a warning with a consistent format
#'
#' Create a warning using a message body that
#' can be formed from multiple text objects.
#' If a single text object is provided then the
#' warning message text will appear on a single
#' line. If multiple text fragments are provided
#' then they will be separated by newlines (in
#' the order provided). Custom formatting is
#' possible by providing a messaging template
#' that uses the string expression scheme used
#' in the \code{glue} package.
#' @param ... a collection of string expressions
#' and named arguments for string interpolation.
#' Bare strings will be pasted together and
#' separated by newlines. Named arguments are
#' used to provide values for string interpolation
#' in the message.
#' @param .format a format template for a
#' message. If not provided, the default template
#' of \code{"{.f_name}: {text}"} will be used.
#' @param .f_name the name of the function that
#' caused the warning. If not provided, the
#' function name will be obtained from the
#' function call stack.
#' @param .issue a logical value that indicates
#' whether a warning should be issued at all.
#' @importFrom glue glue
#' @examples
#' \dontrun{
#' # Write a function that yields a warning with
#' # the requested number of info lines
#' yield_a_warning <- function(msgs) {
#'
#' if (msgs > 3) msgs <- 3
#'
#' # Create some strings can serve as additional
#' # info for the message
#' message_components <-
#' c("* message info 1",
#' "* message info 2",
#' "* message info 3")
#'
#' # Generate and emit a formatted message
#' emit_warning(
#' "There (is/are) {number} thing(s) to note",
#' message_components[1:msgs],
#' number = msgs,
#' .format = "{.f_name} info: {text}")
#' }
#'
#' # When that function is called, a formatted
#' # message will appear; here are some examples:
#' yield_a_warning(msgs = 3)
#' #> Warning message:
#' #> `yield_a_warning()` info: There are 3 things to note
#' #> * message info 1
#' #> * message info 2
#' #> * message info 3
#'
#' yield_a_warning(msgs = 2)
#' #> Warning message:
#' #> `yield_a_warning()` info: There are 2 things to note
#' #> * message info 1
#' #> * message info 2
#'
#' yield_a_warning(msgs = 1)
#' #> Warning message:
#' #> `yield_a_warning()` info: There is 1 thing to note
#' #> * message info 1
#' }
#' @export
emit_warning <- function(...,
.format = NULL,
.f_name = TRUE,
.issue = TRUE) {
# Get the calling function
calling_fcn <- deparse(sys.call(-1))
# If `.issue` evaluates to TRUE then
# follow through to formatting and emitting
# a warning
if (.issue) {
# Collect the list of input components
input_components <- list(...)
# Get a list of named, numeric input components
named_numeric_input_components <-
get_named_numeric_input_components(
input_components = input_components)
# Get a list of named, nonnumeric input components
named_nonnumeric_input_components <-
get_named_nonnumeric_input_components(
input_components = input_components)
# Get a list of unnamed input components
unnamed_input_components <-
get_unnamed_input_components(
input_components = input_components)
# Get a vector of names for all named, numeric inputs
numeric_refs <- names(named_numeric_input_components)
# Get a vector of names for all named, nonnumeric inputs
nonnumeric_refs <- names(named_nonnumeric_input_components)
# Get all text into a single-length character object
text <- squash_all_text(unnamed_input_components)
# Process the format string (`format_str`)
format_str <- process_format_str(.format = .format)
# Process the function name to be used in `format_str`
.f_name <-
process_function_name(
.f_name = .f_name,
calling_fcn = calling_fcn)
# Incorporate the message text into the format string
format_str <-
glue::glue(format_str) %>%
as.character()
# If there is syntax for singular and plural noun forms,
# modify the `format_str` object to finalize the wording
format_str <-
format_str %>%
reprocess_grammar(
named_numeric_input_components = named_numeric_input_components,
named_nonnumeric_input_components = named_nonnumeric_input_components)
# Issue the warning
format_str %>%
as.character() %>%
warning(call. = FALSE)
}
}
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.