Replace base messages with rlang and cli (#76)

* Replace base messages with rlang and cli

* Fix the export that I made by mistake.

* Move all function to cli

R/cnd_df.R

@@ -57,13 +57,13 @@ new_cnd_df <- function(dat, cnd, .warn = TRUE) {
     msg <- c(
       "Number of rows in `dat` must match length of `cnd`."
     )
-    rlang::abort(message = msg)
+    cli::cli_abort(message = msg)
   }
 
   is_cnd_df <- inherits(dat, "cnd_df")
   if (.warn && is_cnd_df) {
     msg <- "`dat` is already a conditioned data frame (`cnd_df`)."
-    rlang::warn(message = msg)
+    cli::cli_warn(message = msg)
   }
 
   if (!is_cnd_df) {
@@ -312,7 +312,7 @@ condition_add <- function(dat, ..., .na = NA, .dat2 = rlang::env()) {
   # TODO: assertion for `.dat2`
 
   if (is_cnd_df(dat)) {
-    rlang::warn(
+    cli::cli_warn(
       c(
         "`dat` is already a conditioned data frame (`cnd_df`).",
         "The previous condition will be replaced by the new one."
@@ -348,11 +348,11 @@ mutate.cnd_df <- function(.data,
                           .before = NULL,
                           .after = NULL) {
   if (!rlang::is_null(.by)) {
-    rlang::abort("`.by` is not supported on conditioned data frames.")
+    cli::cli_abort("`.by` is not supported on conditioned data frames.")
   }
 
   if (!rlang::is_null(.before)) {
-    rlang::abort("`.before` is not supported on conditioned data frames, use `.after` instead.")
+    cli::cli_abort("`.before` is not supported on conditioned data frames, use `.after` instead.")
   }
 
   cnd <- get_cnd_df_cnd(.data) # nolint object_name_linter()

R/ct.R

@@ -65,15 +65,15 @@ assert_ct_spec <- function(ct_spec, optional = FALSE) {
   )
 
   if (!is.null(ct_spec) && nrow(ct_spec) == 0L) {
-    rlang::abort("`ct_spec` can't be empty.")
+    cli::cli_abort("`ct_spec` can't be empty.")
   }
 
   if (!is.null(ct_spec) && anyNA(ct_spec[[ct_spec_vars("ct_clst")]])) {
-    rlang::abort(stringr::str_glue("`{ct_spec_vars('ct_clst')}` can't have any NA values."))
+    cli::cli_abort("`{ct_spec_vars('ct_clst')}` can't have any NA values.")
   }
 
   if (!is.null(ct_spec) && anyNA(ct_spec[[ct_spec_vars("to")]])) {
-    rlang::abort(stringr::str_glue("`{ct_spec_vars('to')}` can't have any NA values."))
+    cli::cli_abort("`{ct_spec_vars('to')}` can't have any NA values.")
   }
 
   invisible(ct_spec)
@@ -107,19 +107,19 @@ assert_ct_clst <- function(ct_spec, ct_clst, optional = FALSE) {
   }
 
   if (is_required_ct_clst_missing) {
-    rlang::abort("`ct_clst` is a required parameter.")
+    cli::cli_abort("`ct_clst` is a required parameter.")
   }
 
   if (is_ct_clst_without_ct_spec) {
-    rlang::abort("`ct_spec` must be a valid controlled terminology if `ct_clst` is supplied.")
+    cli::cli_abort("`ct_spec` must be a valid controlled terminology if `ct_clst` is supplied.")
   }
 
   if (is_ct_clst_missing) {
     return(invisible(NULL))
   }
 
   if (!is_ct_spec_missing && is.na(ct_clst)) {
-    rlang::abort("`ct_clst` can't be NA. Did you mean `NULL`?")
+    cli::cli_abort("`ct_clst` can't be NA. Did you mean `NULL`?")
   }
 
   if (are_ct_spec_ct_clst_available) {
@@ -278,7 +278,7 @@ ct_map <-
 #' read_ct_spec(file = path)
 #'
 #' @export
-read_ct_spec <- function(file = stop("`file` must be specified")) {
+read_ct_spec <- function(file = cli::cli_abort("`file` must be specified")) {
   ct_spec <- utils::read.csv(file = file, na.strings = c("NA", ""), colClasses = "character") |>
     tibble::as_tibble()
   assert_ct_spec(ct_spec)
@@ -327,12 +327,7 @@ ct_spec_example <- function(example) {
   local_path <- system.file(path, package = "sdtm.oak")
 
   if (identical(local_path, "")) {
-    stop(
-      stringr::str_glue(
-        "'{example}' does not match any ct spec files. Run `ct_spec_example()` for options."
-      ),
-      call. = FALSE
-    )
+    cli::cli_abort("'{example}' does not match any ct spec files. Run `ct_spec_example()` for options.", call = NULL)
   } else {
     local_path <-
       system.file(path, package = "sdtm.oak", mustWork = TRUE)

R/derive_blfl.R

@@ -345,7 +345,7 @@ derive_blfl <- function(sdtm_in,
     ))
 
   if (nrow(ds_mod) == 0L) {
-    stop(paste0(
+    cli::cli_abort(paste0(
       "No rows for which both --ORRES is not missing\n  and --STAT not equals to NOT DONE.\n",
       "  Not able to derive Baseline Flag or Last Observation Before Exposure Flag"
     ))
@@ -428,7 +428,7 @@ derive_blfl <- function(sdtm_in,
   ds_base <- dplyr::arrange_at(ds_base, c("USUBJID", con_col))
 
   if (nrow(ds_base) == 0L) {
-    message(paste0("There are no baseline records."))
+    cli::cli_inform("There are no baseline records.")
   }
 
   # Group by USUBJID and --TESTCD and filter on the rows that have max value
@@ -466,12 +466,10 @@ derive_blfl <- function(sdtm_in,
 
   # Assert that merged data frame has same number of rows as input data frame
   if (nrow(ds_out) != nrow(sdtm_in)) {
-    stop(sprintf(
+    cli::cli_abort(
       "Internal error: The processed dataset was expected to have the same
-      number of rows (%d) as the input dataset (sdtm_in), but it actually has %d rows.",
-      nrow(sdtm_in),
-      nrow(ds_out)
-    ))
+      number of rows ({nrow(sdtm_in)}) as the input dataset (sdtm_in), but it actually has {nrow(ds_out)} rows."
+    )
   }
 
   return(ds_out)

R/derive_seq.R

@@ -50,7 +50,7 @@ derive_seq <-
            start_at = 1L) {
     admiraldev::assert_character_scalar(tgt_var)
     if (!is_seq_name(tgt_var)) {
-      rlang::warn("Target variable name (`tgt_var`) should end in 'SEQ'.")
+      cli::cli_warn("Target variable name (`tgt_var`) should end in 'SEQ'.")
     }
 
     admiraldev::assert_character_vector(rec_vars)

R/derive_study_day.R

@@ -62,9 +62,11 @@ derive_study_day <- function(sdtm_in,
   assertthat::assert_that(is.character(study_day_var))
   # check tgdt and study_day_var matching, for example, CMSTDTC matches CMSTDY
   if (gsub("DTC", "", tgdt, fixed = TRUE) != gsub("DY", "", study_day_var, fixed = TRUE)) {
-    warning(
-      "Target date and the returned study day doesn't match. ",
-      "Expecting matching date and study day, for example, CMENDTC and CMENDY"
+    cli::cli_warn(
+      paste(
+        "Target date and the returned study day doesn't match.",
+        "Expecting matching date and study day, for example, CMENDTC and CMENDY"
+      )
     )
   }
 
@@ -77,10 +79,12 @@ derive_study_day <- function(sdtm_in,
       dplyr::group_by(dplyr::pick({{ merge_key }})) |>
       dplyr::filter(dplyr::n() > 1L)
     if (nrow(check_refdt_uniqueness) > 0L) {
-      warning(
-        "Reference date is not unique for each patient! ",
-        "Patient without unique reference date will be ingored. ",
-        "NA will be returned for such records."
+      cli::cli_warn(
+        paste(
+          "Reference date is not unique for each patient!",
+          "Patient without unique reference date will be ingored.",
+          "NA will be returned for such records."
+        )
       )
       dm_domain <- dm_domain[
         !dm_domain[[merge_key]] %in% check_refdt_uniqueness[[merge_key]],
@@ -102,23 +106,27 @@ derive_study_day <- function(sdtm_in,
   sdtm_in[[refdt]] <- tryCatch(
     as.Date(sdtm_in[[refdt]], "%Y-%m-%d"),
     error = function(e) {
-      warning(
-        "Encountered errors when converting refdt to dates. ",
-        "The warning message is ",
-        e$message,
-        call. = FALSE
+      cli::cli_warn(
+        paste(
+          "Encountered errors when converting refdt to dates.",
+          "The warning message is",
+          e$message
+        ),
+        call = NULL
       )
       sdtm_in[[refdt]]
     }
   )
   sdtm_in[[tgdt]] <- tryCatch(
     as.Date(sdtm_in[[tgdt]], "%Y-%m-%d"),
     error = function(e) {
-      warning(
-        "Encountered errors when converting tgdt to dates. ",
-        "The warning message is ",
-        e$message,
-        call. = FALSE
+      cli::cli_warn(
+        paste(
+          "Encountered errors when converting tgdt to dates.",
+          "The warning message is",
+          e$message
+        ),
+        call = NULL
       )
       sdtm_in[[tgdt]]
     }

R/domain_example.R

@@ -79,11 +79,9 @@ domain_example <- function(example) {
   local_path <- system.file(path, package = "sdtm.oak")
 
   if (identical(local_path, "")) {
-    stop(
-      stringr::str_glue(
-        "'{example}' does not match any domain example files. Run `domain_example()` for options."
-      ),
-      call. = FALSE
+    cli::cli_abort(
+      "'{example}' does not match any domain example files. Run `domain_example()` for options.",
+      call = NULL
     )
   } else {
     local_path <-

R/dtc_create_iso8601.R

@@ -30,11 +30,11 @@ iso8601_na <- function(x) {
 #' @keywords internal
 zero_pad_whole_number <- function(x, n = 2L) {
   # Check `x`
-  if (!rlang::is_integerish(x)) rlang::abort("`x` must be integerish.")
+  if (!rlang::is_integerish(x)) cli::cli_abort("`x` must be integerish.")
 
   # Check `n`
   admiraldev::assert_integer_scalar(n)
-  if (n < 1L) rlang::abort("`n` must be positive.")
+  if (n < 1L) cli::cli_abort("`n` must be positive.")
 
   # Negative numbers are not allowed, and hence get converted to NA.
   x[x < 0L] <- NA_integer_
@@ -62,10 +62,10 @@ zero_pad_whole_number <- function(x, n = 2L) {
 #' @keywords internal
 yy_to_yyyy <- function(x, cutoff_2000 = 68L) {
   # Check `x`
-  if (!rlang::is_integerish(x)) rlang::abort("`x` must be integerish.")
+  if (!rlang::is_integerish(x)) cli::cli_abort("`x` must be integerish.")
 
   if (any(x < 0L, na.rm = TRUE)) {
-    rlang::abort("`x` cannot have negative years.")
+    cli::cli_abort("`x` cannot have negative years.")
   }
 
   x <- dplyr::if_else(x <= cutoff_2000, x + 2000L, x)
@@ -318,17 +318,17 @@ create_iso8601 <-
 
     # Check if all vectors in `dots` are of character type.
     if (!identical(unique(sapply(dots, typeof)), "character")) {
-      rlang::abort("All vectors in `...` must be of type character.")
+      cli::cli_abort("All vectors in `...` must be of type character.")
     }
 
     # Check if all vectors in `dots` are of the same length.
     n <- unique(lengths(dots))
     if (!identical(length(n), 1L)) {
-      rlang::abort("All vectors in `...` must be of the same length.")
+      cli::cli_abort("All vectors in `...` must be of the same length.")
     }
 
     if (!identical(length(dots), length(.format))) {
-      rlang::abort("Number of vectors in `...` should match length of `.format`.")
+      cli::cli_abort("Number of vectors in `...` should match length of `.format`.")
     }
 
     # Check that the `.format` is either a character vector or a list of

R/dtc_problems.R

@@ -168,7 +168,7 @@ warn_problems <- function(x) {
       sprintf("There were %d parsing problems.", n_probs),
       "Run `problems()` on parsed results for details."
     )
-    rlang::warn(msg)
+    cli::cli_warn(msg)
   }
 
   invisible(NULL)

R/dtc_utils.R

@@ -34,7 +34,7 @@ assert_dtc_format <- function(.format) {
   switch(typeof(.format),
     character = assert_dtc_fmt(.format),
     list = purrr::map(.format, assert_dtc_format),
-    rlang::abort(abort_msg)
+    cli::cli_abort(abort_msg)
   )
 
   invisible(.format)
@@ -66,13 +66,13 @@ assert_capture_matrix <- function(m) {
   admiraldev::assert_character_vector(m)
 
   if (!is.matrix(m)) {
-    rlang::abort("`m` must be a matrix.")
+    cli::cli_abort("`m` must be a matrix.")
   }
 
   col_names <- c("year", "mon", "mday", "hour", "min", "sec")
   m_col_names <- colnames(m)
   if (is.null(m_col_names) || !all(m_col_names == col_names)) {
-    rlang::abort("`m` must have the following colnames: `year`, `mon`, `mday`, `hour`, `min` and `sec`.")
+    cli::cli_abort("`m` must have the following colnames: `year`, `mon`, `mday`, `hour`, `min` and `sec`.")
   }
 
   invisible(m)
@@ -132,7 +132,7 @@ coalesce_capture_matrices <- function(...) {
   dots <- rlang::list2(...)
 
   if (rlang::is_empty(dots)) {
-    rlang::abort("At least one input must be passed.")
+    cli::cli_abort("At least one input must be passed.")
   }
 
   # Assert that every argument in `...` is a capture matrix

R/parse_dttm_fmt.R

@@ -18,7 +18,7 @@
 #' @keywords internal
 find_int_gap <- function(x, xmin = min(x), xmax = max(x)) {
   if (!rlang::is_integerish(x)) {
-    rlang::abort("`x` must be integer-ish")
+    cli::cli_abort("`x` must be integer-ish")
   }
 
   if (rlang::is_empty(x)) {
@@ -166,7 +166,7 @@ fmt_cmp <- function(sec = "S+",
 
 assert_fmt_c <- function(x) {
   if (!inherits(x, "fmt_c")) {
-    rlang::abort("`x` must be an object created with `fmt_cmp()`.")
+    cli::cli_abort("`x` must be an object created with `fmt_cmp()`.")
   }
 
   invisible(x)
@@ -282,7 +282,7 @@ parse_dttm_fmt_ <- function(fmt, pattern) {
   admiraldev::assert_character_scalar(pattern)
 
   if (identical(nchar(pattern), 0L)) {
-    rlang::abort("`pattern` must be a literal string of at least one char.")
+    cli::cli_abort("`pattern` must be a literal string of at least one char.")
   }
 
   match_data <- regexpr(pattern, fmt)
@@ -333,7 +333,7 @@ parse_dttm_fmt <- function(fmt, patterns = fmt_cmp()) {
   # Check if patterns have matching overlap, i.e. whether they are not
   # mutually exclusive (as they should).
   if (anyDuplicated(pseq(fmt_dttmc$start, fmt_dttmc$end))) {
-    rlang::abort("Patterns in `fmt_c` have overlapping matches.")
+    cli::cli_abort("Patterns in `fmt_c` have overlapping matches.")
   }
 
   # Get captures' ranks while leaving NA as NA (`rank()` won't do this.)

R/pipe.R

@@ -60,7 +60,7 @@
 `%.>%` <- function(lhs, rhs) {
   rhs_expr <- rlang::enexpr(rhs)
   if (!contains_dot(rhs_expr)) {
-    rlang::abort("The right-hand side (rhs) of `%.>%` must contain at least one dot (.) placeholder.")
+    cli::cli_abort("The right-hand side (rhs) of `%.>%` must contain at least one dot (.) placeholder.")
   }
 
   rlang::eval_tidy(rhs_expr, list(. = lhs), env = rlang::caller_env())

vignettes/articles/cnd_df.Rmd → vignettes/cnd_df.Rmd

@@ -1,5 +1,11 @@
 ---
 title: "Conditioned Data Frames"
+output: 
+  rmarkdown::html_vignette
+vignette: >
+  %\VignetteIndexEntry{Conditioned Data Frames}
+  %\VignetteEncoding{UTF-8}
+  %\VignetteEngine{knitr::rmarkdown}
 ---
 
 ```{r setup, include=FALSE}