diff --git a/R/checks.R b/R/checks.R index 4986e099..dbddc7a9 100644 --- a/R/checks.R +++ b/R/checks.R @@ -33,24 +33,16 @@ check_xy <- function(x,y) { error_exists <- TRUE if (x0 && y0) { xy <- c("x", "y") - store_msg("err", - err = paste(cli::symbol$cross, "Error:"), - pale = " Neither {.or {.field {xy}}} table has columns.") + store_joyn_msg(err = " Neither {.or {.strongTable {xy}}} table has columns.") } else if (x0) { - store_msg("err", - err = paste(cli::symbol$cross, "Error:"), - pale = " Input table {.field x} has no columns.") + store_joyn_msg(err = " Input table {.strongTable x} has no columns.") } else { - store_msg("err", - err = paste(cli::symbol$cross, "Error:"), - pale = " Input table {.field y} has no columns.") + store_joyn_msg(err = " Input table {.strongTable y} has no columns.") } } # check names ----------- - # Note (Rossana): in the previous version, the function was not aborting when duplicate names - # were found. This is because it was overwriting the value or error_exists in each step. error_exists <- error_exists || check_duplicate_names(x, "x") error_exists <- error_exists || check_duplicate_names(y, "y") @@ -62,8 +54,6 @@ check_xy <- function(x,y) { return(invisible(TRUE)) } -# NOTE (Rossana): I believe data frames cannot have duplicate names in R in the first place, -# unless you set check.names = FALSE when creating the data.frame #' Check if vars in dt have duplicate names #' @@ -92,12 +82,8 @@ check_duplicate_names <- \(dt, name) { if (anyDuplicated(nm_x)) { dups <- nm_x[duplicated(nm_x)] |> unique() - store_msg("err", - err = paste(cli::symbol$cross, "Error:"), - pale = " Table {.field {name}} has the following - {cli::qty(length(dups))} column{?s} duplicated:", - timing = "{.var {dups}}", - pale = "\nPlease rename or remove and try again.") + store_joyn_msg(err = " Table {.strongTable {name}} has the following {cli::qty(length(dups))} column{?s} duplicated: + {.strongVar {dups}}. \nPlease rename or remove and try again.") return(TRUE) } return(FALSE) @@ -122,27 +108,22 @@ check_duplicate_names <- \(dt, name) { check_reportvar <- function(reportvar, verbose = getOption("joyn.verbose")) { + if (is.character(reportvar)) { + reportvar <- rename_to_valid(reportvar, verbose) - store_msg("info", - ok = cli::symbol$info, " ", ok = cli::symbol$pointer, - " ", - pale = "Joyn's report available in variable", - bolded_pale = " {reportvar}") + + store_joyn_msg(info = "Joyn's report available in variable {.strongVar {reportvar}}") return(reportvar) } else if (is.null(reportvar) || isFALSE(reportvar)) { - store_msg("info", - ok = paste(cli::symbol$info, " Note:"), - pale = " Reporting variable is", - bolded_pale = "\nnot", - pale = "\nreturned") + store_joyn_msg(info = " Reporting variable is {.strong NOT} returned") return(NULL) } else { - cli::cli_abort("reportvar should be character, NULL or FALSE") + cli::cli_abort("{.strongArg reportvar} should be character, NULL or FALSE") } } @@ -313,40 +294,19 @@ check_match_type <- function(x, y, by, switch( m_m, "warn_y" = { - store_msg( - type = "warn", - warn = paste(cli::symbol$warn, "\nWarning:"), - pale = "\nThe keys supplied uniquely identify", - bolded_pale = "\ny", - pale = "\ntherefore a", - bolded_pale = "\n{tx}:1", - pale = "\njoin is executed." - ) + store_joyn_msg(warn = "The keys supplied uniquely identify {.strongTable y}, + therefore a {.strong {tx}:1} join is executed") }, "warn_x" = { - store_msg( - type = "warn", - warn = paste(cli::symbol$warn,"\nWarning:"), - pale = "\nThe keys supplied uniquely identify", - bolded_pale = "\nx", - pale = "\ntherefore a", - bolded_pale = "\n1:{ty}", - pale = "\njoin is executed." - ) + store_joyn_msg(warn = "The keys supplied uniquely identify {.strongTable x}, + therefore a {.strong 1:{ty}} join is executed") }, #}, "warn_both" = { - store_msg( - type = "warn", - warn = paste(cli::symbol$warn, "\nWarning:"), - pale = "\nThe keys supplied uniquely identify both", - bolded_pale = "\nx and y", - pale = "\ntherefore a", - bolded_pale = "\n1:1", - pale = "\njoin is executed." - ) + store_joyn_msg(warn = "The keys supplied uniquely identify both {.strongTable x and y}, + therefore a {.strong 1:1} join is executed") } ) @@ -385,12 +345,7 @@ is_match_type_error <- function(x, name, by, verbose, match_type_error) { match_type_error <- TRUE by2 <- by - store_msg("err", - err = paste(cli::symbol$cross, "Error:"), - pale = " table", - bolded_pale = " {name}", - pale = " is not uniquely identified by", - bolded_pale = " {by2}") + store_joyn_msg(err = "table {.strongTable {name}} is not uniquely identified by {.strongVar {by2}}") } match_type_error @@ -424,7 +379,7 @@ is_match_type_error <- function(x, name, by, verbose, match_type_error) { check_y_vars_to_keep <- function(y_vars_to_keep, y, by) { if (length(y_vars_to_keep) > 1 && !is.character(y_vars_to_keep)) { - cli::cli_abort("argumet {.arg y_vars_to_keep} must be of length 1 + cli::cli_abort("argumet {.arg {y_vars_to_keep}} must be of length 1 when it is not class character") } @@ -456,12 +411,7 @@ check_y_vars_to_keep <- function(y_vars_to_keep, y, by) { y_in_by <- y_vars_to_keep %in% by if (any(y_in_by)) { - store_msg("info", - ok = paste(cli::symbol$info, " ", cli::symbol$pointer, " "), - pale = "Removing key variables", - bolded_pale = " {y_vars_to_keep[y_in_by]}", - pale = " from", - bolded_pale = " {y_vars_to_keep}") + store_joyn_msg(info = "Removing key variables {.strongVar {y_vars_to_keep[y_in_by]}} from {.strongVar {y_vars_to_keep}}") } y_vars_to_keep <- y_vars_to_keep[!y_in_by] diff --git a/R/dplyr-joins.R b/R/dplyr-joins.R index f0c5609d..22257d69 100644 --- a/R/dplyr-joins.R +++ b/R/dplyr-joins.R @@ -464,17 +464,8 @@ full_join <- function( # Unmatched Keys---------------------------------------- if (unmatched == "error") { - # Store warning message - store_msg( - type = "warn", - warn = paste(cli::symbol$warn, "\nWarning:"), - pale = "\nargument", - bolded_pale = " warning = error", - pale = "\nis not active in this type of", - bolded_pale = " joyn" - ) - + store_joyn_msg(warn = "argument {.strongArg warning = error} is not active in this type of joyn") } # Should reportvar be kept @@ -824,14 +815,7 @@ arguments_checks <- function(x, y, by, copy, keep, suffix, na_matches, multiple, # Check copy if (copy == TRUE) { - store_msg( - type = "warn", - warn = paste(cli::symbol$warn, "\nWarning:"), - pale = "\nargument", - bolded_pale = " copy = TRUE", - pale = "\nis not active in this version of", - bolded_pale = " joyn" - ) + store_joyn_msg(warn = "argument {.strongArg copy = TRUE} is not active in this version of joyn") } # Check suffix @@ -854,13 +838,7 @@ arguments_checks <- function(x, y, by, copy, keep, suffix, na_matches, multiple, ) } if (is.null(keep)) { - store_msg( - type = "warn", - warn = paste(cli::symbol$warn,"\nWarning:"), - pale = " joyn does not currently allow inequality joins, so", - bolded_pale = " keep = NULL", - pale = " will retain only keys in x" - ) + store_joyn_msg(warn = "joyn does not currently allow inequality joins, so {.strongArg keep = NULL} will retain only keys in {.strongTable x}") keep <- FALSE } @@ -893,12 +871,7 @@ arguments_checks <- function(x, y, by, copy, keep, suffix, na_matches, multiple, # Check na_matches if (na_matches == "never") { - store_msg( - type = "warn", - warn = paste(cli::symbol$warn, "\nWarning:"), - pale = " Currently, joyn allows only", - bolded_pale = " na_matches = 'na'" - ) + store_joyn_msg(warn = "Currently, joyn allows only {.strongArg na_matches = 'na'}") } # Check reportvar diff --git a/R/info_display.R b/R/info_display.R index 9aad77d4..8b609050 100644 --- a/R/info_display.R +++ b/R/info_display.R @@ -118,7 +118,111 @@ store_msg <- function(type, ...) { } +#' Wrapper for store_msg function +#' This function serves as a wrapper for the store_msg function, which is used to store various types of messages within the .joyn environment. +#' :errors, warnings, timing information, or info +#' @param err A character string representing an error message to be stored. Default value is NULL +#' @param warn A character string representing a warning message to be stored. Default value is NULL +#' @param timing A character string representing a timing message to be stored. Default value is NULL +#' @param info A character string representing an info message to be stored. Default value is NULL +#' +#' @section Hot to pass the message string: +#' The function allows for the customization of the message string using {cli} classes to emphasize specific components of the message +#' Here's how to format the message string: +#' *For variables: .strongVar --example: "{.strongVar {reportvar}}" +#' *For function arguments: .strongArg --example: "{.strongArg {y_vars_to_keep}}" +#' *For dt/df: .strongTable --example: "{.strongTable x}" +#' *For text/anything else: .strong --example: "reportvar is {.strong NOT} returned" +#' *NOTE: By default, the number of seconds specified in timing messages is +#' automatically emphasized using a custom formatting approach. +#' You do not need to apply {cli} classes nor to specify that the number is in seconds. +#' --example usage: store_joyn_msg(timing = +#' paste("The full joyn is executed in", round(time_taken, 6))) +#' +#' +#' @return invisible TRUE +#' +#' @keywords internal +store_joyn_msg <- function(err = NULL, + warn = NULL, + timing = NULL, + info = NULL) { + + # Check that only one among err, warn, timing and info is not null, otherwise stop + + cn <- c(err, warn, timing, info) + + if (length(cn) != 1) { + cli::cli_abort(c("only one of err, warn, timing, info can be not null", + "i" = "check the arguments")) + } + + + # Error messages ----------------------------------------- + + if (!is.null(err)) { + + err <- cli::format_inline(err, .envir = parent.frame(1)) + + store_msg("err", + err = paste(cli::symbol$cross, "Error: "), + pale = err) + + return(invisible(TRUE)) + + } + + # Warning messages ----------------------------------------- + + else if (!is.null(warn)) { + + warn <- cli::format_inline(warn, .envir = parent.frame(1)) + store_msg("warn", + warn = paste(cli::symbol$warn, "Warning: "), + pale = warn) + + return(invisible(TRUE)) + } + + # Timing messages ----------------------------------------- + + else if (!is.null(timing)) { + + # detect number + num_pattern <- "[0-9]+\\.?[0-9]*" + + timing_num <- regmatches(timing, + gregexpr(num_pattern, timing)) + + timing <- cli::format_inline(timing, .envir = parent.frame(1)) + + store_msg(type = "timing", + timing = paste(cli::symbol$record, " Timing:"), + pale = sub(timing_num, "", timing), + timing = timing_num, + pale = " seconds.") + + return(invisible(TRUE)) + + } + + # Info messages ----------------------------------------- + + else if (!is.null(info)) { + + info <- cli::format_inline(info, .envir = parent.frame(1)) + + store_msg(type = "info", + ok = paste(cli::symbol$info, " Note: "), + pale = info) + + return(invisible(TRUE)) + + } + + return(FALSE) # This should never be reached +} check_style <- \(...) { if (length(list(...)) == 0) { diff --git a/R/joyn-merge.R b/R/joyn-merge.R index 52f7a970..134ce630 100644 --- a/R/joyn-merge.R +++ b/R/joyn-merge.R @@ -285,10 +285,10 @@ joyn <- function(x, if (keep == "anti" & (isTRUE(update_values) || isTRUE(update_NAs))) { - store_msg("warn", - warn = paste(cli::symbol$warning, " Warning:"), - pale = " cannot use arguments {.code update_values = TRUE} - and/or {.code update_NAs = TRUE} for anti join") + + store_joyn_msg(warn = "cannot use arguments {.strongArg update_values = TRUE} + and/or {.strongArg update_NAs = TRUE} for anti join") + update_values <- FALSE update_NAs <- FALSE } @@ -375,12 +375,8 @@ joyn <- function(x, check_names <- make.names(check_names, unique = TRUE) nrv <- setdiff(check_names, xnames) - store_msg(type = "info", - ok = paste(cli::symbol$info, " Note: "), - pale = "reportvar", - bolded_pale = " {reportvar}", - pale = " is already part of the resulting table. It will be changed to", - bolded_pale = " {nrv}") + store_joyn_msg(info = "reportvar {.strongVar {reportvar}} is already part of the resulting table. It will be changed to {.strongVar {nrv}}") + reportvar <- nrv } } @@ -497,11 +493,10 @@ joyn <- function(x, all(x[[reportvar]] %in% c(1, 2))) && !keep == "anti") { - store_msg("warn", - warn = paste(cli::symbol$warning, " Warning:"), - pale = " you have no matching obs. Make sure argument - `by` is correct. Right now, `joyn` is joining by - {.code {by}}") + store_joyn_msg(warn = " you have no matching obs. Make sure argument + `by` is correct. Right now, `joyn` is joining by + {.strongVar {by}}") + } ## Display results------ @@ -517,15 +512,9 @@ joyn <- function(x, # store timing end_joyn <- Sys.time() time_taken_joyn <- end_joyn - start_joyn - store_msg( - type = "timing", - timing = paste(cli::symbol$record, " Timing:"), - pale = " The entire joyn function, including checks, - is executed in ", - timing = round(time_taken_joyn, 6), - pale = " seconds" - ) + store_joyn_msg(timing = paste(" The entire joyn function, including checks, + is executed in ", round(time_taken_joyn, 6))) # return messages if (verbose == TRUE) { diff --git a/R/joyn_workhorse.R b/R/joyn_workhorse.R index 433988b6..d19f6fa7 100644 --- a/R/joyn_workhorse.R +++ b/R/joyn_workhorse.R @@ -1,5 +1,5 @@ -#' Internal workhorse join function, used in the backend of `joyn` +#' Internal workhorse join function, used in the back-end of `joyn` #' #' Always executes a full join. #' @@ -47,22 +47,11 @@ joyn_workhorse <- function( if ( length(by) == 0 ) { - store_msg( - type = "err", - err = cli::symbol$cross, - err = " Error:", - pale = " in joyn_workhorse,", - bolded_pale = " by", - pale = " argument has length of 0" - ) - store_msg( - type = "info", - ok = cli::symbol$info, " ", - note = "\nNote:", - pale = " Either specify by to identify columns to join on in x and y, or - x and y should have common column names" - ) + store_joyn_msg(err = "In joyn_workhorse {.strongArg by} argument has length of 0") + + store_joyn_msg(info = "Either specify by to identify columns to join on in x and y, or x and y should have common column names") + } # Measure time start_time <- Sys.time() @@ -98,19 +87,13 @@ joyn_workhorse <- function( warning = function(w) { if (grepl("[Oo]veridentified", w$message)) { - store_msg( - type = "warn", - ok = paste(cli::symbol$warning, "\nWarning: "), - pale = "Your data is overidentified. Below the original message from {.pkg {source_pkg}}:", - bolded_pale = "\n{w$message}" - ) + + store_joyn_msg(warn = "Your data is overidentified. Below the original message from {.strong {source_pkg}}: \n{w$message}") + } else { - store_msg( - type = "warn", - ok = paste(cli::symbol$warning, "\nWarning: "), - pale = "{.pkg {source_pkg}} returned the following warning:", - bolded_pale = "\n{w$message}" - ) + + store_joyn_msg(warn = "{.strong {source_pkg}} returned the following warning: \n{w$message}") + } collapse::join( x = x, @@ -134,13 +117,7 @@ joyn_workhorse <- function( end_time <- Sys.time() time_taken <- end_time - start_time - store_msg( - type = "timing", - timing = paste(cli::symbol$record, " Timing:"), - pale = " The full joyn is executed in ", - timing = round(time_taken, 6), - pale = " seconds" ) - + store_joyn_msg(timing = paste("The full joyn is executed in", round(time_taken, 6))) # Return ---- return( diff --git a/R/merge-data.table.R b/R/merge-data.table.R index 6b4e09be..9dc1f900 100644 --- a/R/merge-data.table.R +++ b/R/merge-data.table.R @@ -148,11 +148,9 @@ check_dt_by <- \(x, y, by, by.x, by.y) { cli::cli_abort("`by.x` and `by.y` must be of same length.") } if (!missing(by) && !missing(by.x)) { - store_msg("warn", - warn = paste(cli::symbol$warning, " Warning:"), - pale = " Supplied both", - bolded_pale = " by and by.x/by.y. by", - pale = " argument will be ignored.") + + store_joyn_msg(warn = " Supplied both {.strong by and by.x/by.y. by} argument will be ignored. ") + } if (!is.null(by.x)) { diff --git a/R/utils.R b/R/utils.R index 6a72bee3..be4a5b24 100644 --- a/R/utils.R +++ b/R/utils.R @@ -144,10 +144,7 @@ unmask_joyn_fun_ns <- function(fun_name, # if package {pkg_name} is not loaded, stop and inform user if (!pkg_name %in% tolower(.packages())) { - store_msg(type = "err", - err = paste(cli::symbol$cross, "Error:"), - pale = " package {pkg_name} must be loaded." - ) + store_joyn_msg(err = "package {.strong {pkg_name}} must be loaded.") joyn_msg("err") cli::cli_abort("{pkg_name} is not loaded") @@ -157,9 +154,7 @@ unmask_joyn_fun_ns <- function(fun_name, if (!any(fun_name %in% getNamespaceExports(pkg_name))) { - store_msg(type = "err", - err = paste(cli::symbol$cross, "Error:"), - pale = " {fun_name} must be exported object(s) of {pkg_name}." + store_joyn_msg(err = " {.strong {fun_name}} must be exported object(s) of {.strong {pkg_name}}." ) joyn_msg("err") @@ -284,13 +279,7 @@ unmask_joyn <- \(fun_name, clear_joynenv() # Inform the user - store_msg(type = "info", - ok = paste(cli::symbol$info, " Note: "), - pale = "function", - bolded_pale = " {fun_name}", - pale = " unmasked.", - bolded_pale = " {pkg_name}::{fun_name}", - pale = " preferred") + store_joyn_msg(info = "function {.strong {fun_name}} unmasked. {.strong {pkg_name}::{fun_name}} preferred") joyn_msg() diff --git a/R/zzz.R b/R/zzz.R index df0ec53b..d6caf669 100644 --- a/R/zzz.R +++ b/R/zzz.R @@ -139,3 +139,38 @@ set_joyn_options <- function(..., } +# ------------------------------------------------------------------------------------------ +# Define custom .strong {cli} classes to emphasize messages subcomponents +# --- to be used when creating/storing {joyn} messages +# ------------------------------------------------------------------------------------------- + +# Class 'strong' - for text/general subcomponents of the msg that we want to highlight +cli::cli_div(theme = list( + span.strong = list(color = "#555555"), + "span.strong" = list("font-weight" = "bold")), + .auto_close = FALSE) + +# Class `strongVar` - to highlight variables/column names +cli::cli_div(theme = list( + span.strongVar = list(color = "#0a9396"), + "span.strongVar" = list(before = "`"), + "span.strongVar" = list("font-weight" = "bold"), + "span.strongVar" = list(after = "`")), + .auto_close = FALSE) + +# Class `strongTable` - to highlight data tables/frames (e.g., x or y) +cli::cli_div(theme = list( + span.strongTable = list(color = "#BF00FF"), + "span.strongTable" = list(before = "`"), + "span.strongTable" = list("font-weight" = "bold"), + "span.strongTable" = list(after = "`")), + .auto_close = FALSE) + +# Class `strongArg` - to highlight function arguments (e.g., suffixes, match type) +cli::cli_div(theme = list( + span.strongArg = list(color = "#0077b6"), + "span.strongArg" = list("font-weight" = "bold")), + .auto_close = FALSE) + + + diff --git a/man/joyn_workhorse.Rd b/man/joyn_workhorse.Rd index 6733e184..fed075be 100644 --- a/man/joyn_workhorse.Rd +++ b/man/joyn_workhorse.Rd @@ -2,7 +2,7 @@ % Please edit documentation in R/joyn_workhorse.R \name{joyn_workhorse} \alias{joyn_workhorse} -\title{Internal workhorse join function, used in the backend of \code{joyn}} +\title{Internal workhorse join function, used in the back-end of \code{joyn}} \usage{ joyn_workhorse( x, diff --git a/man/store_joyn_msg.Rd b/man/store_joyn_msg.Rd new file mode 100644 index 00000000..6f002a88 --- /dev/null +++ b/man/store_joyn_msg.Rd @@ -0,0 +1,43 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/info_display.R +\name{store_joyn_msg} +\alias{store_joyn_msg} +\title{Wrapper for store_msg function +This function serves as a wrapper for the store_msg function, which is used to store various types of messages within the .joyn environment. +:errors, warnings, timing information, or info} +\usage{ +store_joyn_msg(err = NULL, warn = NULL, timing = NULL, info = NULL) +} +\arguments{ +\item{err}{A character string representing an error message to be stored. Default value is NULL} + +\item{warn}{A character string representing a warning message to be stored. Default value is NULL} + +\item{timing}{A character string representing a timing message to be stored. Default value is NULL} + +\item{info}{A character string representing an info message to be stored. Default value is NULL} +} +\value{ +invisible TRUE +} +\description{ +Wrapper for store_msg function +This function serves as a wrapper for the store_msg function, which is used to store various types of messages within the .joyn environment. +:errors, warnings, timing information, or info +} +\section{Hot to pass the message string}{ + +The function allows for the customization of the message string using {cli} classes to emphasize specific components of the message +Here's how to format the message string: +*For variables: .strongVar --example: "{.strongVar {reportvar}}" +*For function arguments: .strongArg --example: "{.strongArg {y_vars_to_keep}}" +*For dt/df: .strongTable --example: "{.strongTable x}" +*For text/anything else: .strong --example: "reportvar is {.strong NOT} returned" +*NOTE: By default, the number of seconds specified in timing messages is +automatically emphasized using a custom formatting approach. +You do not need to apply {cli} classes nor to specify that the number is in seconds. +--example usage: store_joyn_msg(timing = +paste("The full joyn is executed in", round(time_taken, 6))) +} + +\keyword{internal}