Skip to content

Commit

Permalink
Merge pull request #63 from randrescastaneda/msgs_function
Browse files Browse the repository at this point in the history 
Wrapper function for `store_msg`
  • Loading branch information
@randrescastaneda
randrescastaneda authored Jun 7, 2024
2 parents 01f1c0a + 414fcb9 commit 6ca6b27
Show file tree
Hide file tree
Showing 10 changed files with 237 additions and 179 deletions.
90 changes: 20 additions & 70 deletions R/checks.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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")
Expand All @@ -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
#'
Expand Down Expand Up @@ -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)
Expand All @@ -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")
}
}

Expand Down Expand Up @@ -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")
}
)

Expand Down Expand Up @@ -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
Expand Down Expand Up @@ -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")
}

Expand Down Expand Up @@ -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]
Expand Down
35 changes: 4 additions & 31 deletions R/dplyr-joins.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down Expand Up @@ -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
Expand All @@ -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
}

Expand Down Expand Up @@ -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
Expand Down
104 changes: 104 additions & 0 deletions R/info_display.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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) {
Expand Down
Loading

0 comments on commit 6ca6b27

Please sign in to comment.