Implement specify_df()

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: hrmn
 Title: Harmonize Datasets
-Version: 0.0.0.9002
+Version: 0.0.0.9003
 Authors@R:
     person("Jon", "Harmon", , "jonthegeek@gmail.com", role = c("aut", "cre"),
            comment = c(ORCID = "0000-0003-4781-4346"))
@@ -22,6 +22,7 @@ Language: en-US
 Roxygen: list(markdown = TRUE)
 RoxygenNote: 7.3.3
 Imports:
+    cli,
     fastmatch,
     rlang,
     stbl

NAMESPACE

@@ -1,6 +1,11 @@
 # Generated by roxygen2: do not edit by hand
 
+export(caller_arg)
+export(caller_env)
 export(harmonize_fct)
+export(specify_df)
 export(specify_fct)
 importFrom(fastmatch,"%fin%")
 importFrom(rlang,"%||%")
+importFrom(rlang,caller_arg)
+importFrom(rlang,caller_env)

R/aaa-conditions.R

@@ -0,0 +1,90 @@
+#' @importFrom rlang caller_arg
+#' @export
+rlang::caller_arg
+
+#' @importFrom rlang caller_env
+#' @export
+rlang::caller_env
+
+#' Signal an error with standards applied
+#'
+#' A wrapper around [cli::cli_abort()] to throw classed errors.
+#'
+#' @param message (`character`) The message for the new error. Messages will be
+#'   formatted with [cli::cli_bullets()].
+#' @param ... Additional parameters passed to [cli::cli_abort()] and on to
+#'   [rlang::abort()].
+#' @inheritParams .shared_params
+#' @keywords internal
+.hrmn_abort <- function(
+  message,
+  subclass,
+  call = caller_env(),
+  message_env = call,
+  parent = NULL,
+  ...
+) {
+  cli::cli_abort(
+    message,
+    class = c(
+      .compile_error_class("hrmn", "error", subclass),
+      .compile_error_class("hrmn", "error"),
+      .compile_error_class("hrmn", "condition")
+    ),
+    call = call,
+    .envir = message_env,
+    parent = parent,
+    ...
+  )
+}
+
+#' Compile an error class
+#'
+#' @param ... `(character)` Components of the class name.
+#' @returns A length-1 character vector.
+#' @keywords internal
+.compile_error_class <- function(...) {
+  paste(..., sep = "-")
+}
+
+#' Check that all specified args are named
+#'
+#' @param ... Arguments to check.
+#' @inheritParams .shared_params
+#' @returns `NULL`, invisibly.
+#' @keywords internal
+.check_args_named <- function(..., call = rlang::caller_env()) {
+  if (...length() && (is.null(...names()) || !all(nzchar(...names())))) {
+    .hrmn_abort(
+      "All arguments must be named.",
+      "args_unnamed",
+      call = call
+    )
+  }
+  invisible(NULL)
+}
+
+#' Check that all args are hrmn_spec objects
+#'
+#' @param ... Arguments to check.
+#' @inheritParams .shared_params
+#' @returns `NULL`, invisibly.
+#' @keywords internal
+.check_args_spec <- function(..., call = rlang::caller_env()) {
+  dots <- list(...)
+  is_spec <- vapply(dots, inherits, logical(1), "hrmn_spec")
+  if (length(dots) && !all(is_spec)) {
+    bad_args <- rlang::names2(is_spec)[!is_spec]
+    bad_args[bad_args == ""] <- "<unnamed>"
+    .hrmn_abort(
+      c(
+        "All arguments must be `hrmn_spec` objects.",
+        "x" = "Argument{?s} {.arg {bad_args}} {?is/are} not {?a / }`hrmn_spec` object{?s}."
+      ),
+      subclass = "args_not_spec",
+      call = call,
+      message_env = rlang::current_env()
+    )
+  }
+  invisible(NULL)
+}

R/aaa-shared_params.R

@@ -2,8 +2,15 @@
 #'
 #' Reused parameter definitions are gathered here for easier editing.
 #'
+#' @param call `(environment)` The execution environment to mention as the
+#'   source of error messages.
 #' @param levels (`character`) The allowed values of the factor.
-#'
+#' @param message_env (`environment`) The execution environment to use to
+#'   evaluate variables in error messages.
+#' @param parent A parent condition, as you might create during a
+#'   [rlang::try_fetch()]. See [rlang::abort()] for additional information.
+#' @param subclass (`character`) Class(es) to assign to the error. Will be
+#'   prefixed by "hrmn-error-".
 #' @name .shared_params
 #' @keywords internal
 NULL

R/harmonize_fct.R

@@ -4,14 +4,13 @@
 #'   to the specified factor.
 #' @inheritParams .shared_params
 #' @inheritParams rlang::args_dots_empty
-#' @param .spec (`hrmn_fct_spec`) A harmonization specification from
+#' @param .spec (`hrmn_spec_fct`) A harmonization specification from
 #'   [specify_fct()].
 #' @param .lookup (named `character`) A vector of replacement values. The names
 #'   are the values in `.data` and the values are the target values.
 #'
 #' @returns A harmonized [factor()].
-#' @export
-#'
+#' @family harmonization functions
 #' @examples
 #' # Without a spec, harmonize_fct() acts like [base::factor()].
 #' harmonize_fct(c("a", "b", "c"))
@@ -28,6 +27,7 @@
 #'   .spec = spec2,
 #'   .lookup = lookup
 #' )
+#' @export
 harmonize_fct <- function(.data, ..., .spec = NULL, .lookup = NULL) {
   rlang::check_dots_empty()
   .data <- stbl::to_chr(.data)

R/specify_df.R

@@ -0,0 +1,21 @@
+#' Data frame specification
+#'
+#' Create an object that specifies the desired format for a data frame.
+#' This specification object does not contain any data itself, only the rules
+#' for harmonization.
+#'
+#' @param ... (`hrmn_spec`) Column specifications, given as named arguments.
+#'
+#' @returns A `hrmn_spec_df` object that acts as a specification.
+#' @family specification functions
+#' @examples
+#' specify_df(
+#'   response = specify_fct(levels = c("Yes", "No", "Maybe")),
+#'   outcome = specify_fct(levels = c("Positive", "Negative"))
+#' )
+#' @export
+specify_df <- function(...) {
+  .check_args_named(...)
+  .check_args_spec(...)
+  structure(list(...), class = c("hrmn_spec_df", "hrmn_spec", "list"))
+}

R/specify_fct.R

@@ -6,14 +6,14 @@
 #'
 #' @inheritParams .shared_params
 #'
-#' @returns A `hrmn_fct_spec` object that acts as a specification.
-#' @export
-#'
+#' @returns A `hrmn_spec_fct` object that acts as a specification.
+#' @family specification functions
 #' @examples
 #' specify_fct(levels = c("a", "b", "c"))
+#' @export
 specify_fct <- function(levels = character()) {
   structure(
     list(levels = stbl::to_chr(levels)),
-    class = c("hrmn_fct_spec", "hrmn_spec", "list")
+    class = c("hrmn_spec_fct", "hrmn_spec", "list")
   )
 }