Improve errors for set_mode and set_engine

Author: juliasilge

R/aaa_models.R

@@ -133,21 +133,22 @@ check_mode_val <- function(mode) {
   invisible(NULL)
 }
 
+
+glue_compatible_modes <- function(cls, spec_modes) {
+  glue::glue(
+    "Available modes are: ",
+    glue::glue_collapse(glue::glue("'{spec_modes}'"), sep = ", ")
+  )
+}
+
 # check if class and mode are compatible
 check_spec_mode_val <- function(cls, mode) {
   spec_modes <- rlang::env_get(get_model_env(), paste0(cls, "_modes"))
-  compatible_modes <-
-    glue::glue(
-      "`mode` should be one of: ",
-      glue::glue_collapse(glue::glue("'{spec_modes}'"), sep = ", ")
-    )
-
-  if (is.null(mode)) {
-    rlang::abort(compatible_modes)
+  if (is.null(mode) | length(mode) > 1) {
+    rlang::abort(glue_compatible_modes(cls, spec_modes))
   } else if (!(mode %in% spec_modes)) {
-    rlang::abort(compatible_modes)
+    rlang::abort(glue_compatible_modes(cls, spec_modes))
   }
-
   invisible(NULL)
 }
 

R/arguments.R

@@ -76,11 +76,12 @@ set_args <- function(object, ...) {
 #' @rdname set_args
 #' @export
 set_mode <- function(object, mode) {
+  cls <- class(object)[1]
   if (rlang::is_missing(mode)) {
-    mode <- NULL
+    spec_modes <- rlang::env_get(get_model_env(), paste0(cls, "_modes"))
+    rlang::abort(glue_compatible_modes(cls, spec_modes))
   }
-  mode <- mode[1]
-  check_spec_mode_val(class(object)[1], mode)
+  check_spec_mode_val(cls, mode)
   object$mode <- mode
   object
 }

R/engines.R

@@ -10,23 +10,20 @@ possible_engines <- function(object, ...) {
   unique(engs$engine)
 }
 
+glue_compatible_engines <- function(engine, avail_eng) {
+  glue::glue(
+    "Available engines are: ",
+    glue::glue_collapse(glue::glue("'{avail_eng}'"), sep = ", ")
+  )
+}
+
 check_engine <- function(object) {
   avail_eng <- possible_engines(object)
-  if (is.null(object$engine)) {
-    object$engine <- avail_eng[1]
-    rlang::warn(glue::glue("`engine` was NULL and updated to be `{object$engine}`"))
-  } else {
-    if (!is.character(object$engine) | length(object$engine) != 1) {
-      rlang::abort("`engine` should be a single character value.")
-    }
-  }
-  if (!(object$engine %in% avail_eng)) {
-    rlang::abort(
-      glue::glue(
-        "Engine '{object$engine}' is not available. Please use one of: ",
-        glue::glue_collapse(glue::glue("'{avail_eng}'"), sep = ", ")
-      )
-    )
+  eng <- object$engine
+  if (is.null(eng) | length(eng) > 1) {
+    rlang::abort(glue_compatible_engines(eng, avail_eng))
+  } else if (!(eng %in% avail_eng)) {
+    rlang::abort(glue_compatible_engines(eng, avail_eng))
   }
   object
 }
@@ -97,7 +94,8 @@ set_engine <- function(object, engine, ...) {
   }
 
   if (rlang::is_missing(engine)) {
-    engine <- NULL
+    avail_eng <- possible_engines(object)
+    rlang::abort(glue_compatible_engines(object$engine, avail_eng))
   }
   object$engine <- engine
   object <- check_engine(object)