pass spec rather than cls to checking fxns

by passing the spec rather than it's class to the `spec_is_*` functions, we can cut down on the number of arguments we need to supply by setting defaults based on `spec`s slots, only supplying additional arguments when we "propose" new slots in `set_` functions.

Author: simonpcouch

R/arguments.R

@@ -102,9 +102,8 @@ set_mode.model_spec <- function(object, mode) {
   # determine if the model specification could feasibly match any entry
   # in the union of the parsnip model environment and model_info_table.
   # if not, trigger an error based on the (possibly inferred) model spec slots.
-  if (!spec_is_possible(cls,
-                        object$engine, object$user_specified_engine,
-                        mode, user_specified_mode = TRUE)) {
+  if (!spec_is_possible(spec = object,
+                        mode = mode, user_specified_mode = TRUE)) {
     check_spec_mode_engine_val(cls, object$engine, mode)
   }
 

R/engines.R

@@ -120,9 +120,8 @@ set_engine.model_spec <- function(object, engine, ...) {
   # determine if the model specification could feasibly match any entry
   # in the union of the parsnip model environment and model_info_table.
   # if not, trigger an error based on the (possibly inferred) model spec slots.
-  if (!spec_is_possible(mod_type,
-                        object$engine, user_specified_engine = TRUE,
-                        object$mode, object$user_specified_mode)) {
+  if (!spec_is_possible(spec = object,
+                        engine = object$engine, user_specified_engine = TRUE)) {
     check_spec_mode_engine_val(mod_type, object$engine, object$mode)
   }
 

R/extract.R

@@ -74,19 +74,9 @@ extract_fit_engine.model_fit <- function(x, ...) {
 #' @export
 #' @rdname extract-parsnip
 extract_parameter_set_dials.model_spec <- function(x, ...) {
-  if (!spec_is_loaded(
-    cls = class(x)[1],
-    engine = x$engine,
-    user_specified_engine = x$user_specified_engine,
-    mode = x$mode,
-    user_specified_mode = x$user_specified_mode
-  )) {
+  if (!spec_is_loaded(spec = x)) {
     prompt_missing_implementation(
-      cls = class(x)[1],
-      engine = x$engine,
-      user_specified_engine = x$user_specified_engine,
-      mode = x$mode,
-      user_specified_mode = x$user_specified_mode,
+      spec = x,
       prompt = cli::cli_abort,
       call = NULL
     )

R/fit.R

@@ -121,11 +121,7 @@ fit.model_spec <-
 
     if (length(possible_engines(object)) == 0) {
       prompt_missing_implementation(
-        cls = class(object)[1],
-        engine = object$engine,
-        user_specified_engine = object$user_specified_engine,
-        mode = object$mode,
-        user_specified_mode = object$user_specified_mode,
+        spec = object,
         prompt = cli::cli_abort,
         call = call2("fit")
       )

R/misc.R

@@ -58,7 +58,7 @@ mode_filter_condition <- function(mode, user_specified_mode) {
 #'
 #' The helpers `spec_is_possible()`, `spec_is_loaded()`, and
 #' `prompt_missing_implementation()` provide tooling for checking
-#' model specifications. In addition to the `cls`, `engine`, and `mode`
+#' model specifications. In addition to the `spec`, `engine`, and `mode`
 #' arguments, the functions take arguments `user_specified_engine` and
 #' `user_specified_mode`, denoting whether the user themselves has
 #' specified the engine or mode, respectively.
@@ -91,9 +91,13 @@ mode_filter_condition <- function(mode, user_specified_mode) {
 #' @export
 #' @keywords internal
 #' @rdname add_on_exports
-spec_is_possible <- function(cls,
-                             engine, user_specified_engine,
-                             mode, user_specified_mode) {
+spec_is_possible <- function(spec,
+                             engine = spec$engine,
+                             user_specified_engine = spec$user_specified_engine,
+                             mode = spec$mode,
+                             user_specified_mode = spec$user_specified_mode) {
+  cls <- class(spec)[[1]]
+
   all_model_info <-
     dplyr::full_join(
       read_model_info_table(),
@@ -119,9 +123,13 @@ spec_is_possible <- function(cls,
 #' @export
 #' @keywords internal
 #' @rdname add_on_exports
-spec_is_loaded <- function(cls,
-                           engine, user_specified_engine,
-                           mode, user_specified_mode) {
+spec_is_loaded <- function(spec,
+                           engine = spec$engine,
+                           user_specified_engine = spec$user_specified_engine,
+                           mode = spec$mode,
+                           user_specified_mode = spec$user_specified_mode) {
+  cls <- class(spec)[[1]]
+
   engine_condition <- engine_filter_condition(engine, user_specified_engine)
   mode_condition <- mode_filter_condition(mode, user_specified_mode)
 
@@ -143,9 +151,7 @@ spec_is_loaded <- function(cls,
 
 is_printable_spec <- function(x) {
   !is.null(x$method$fit$args) &&
-    spec_is_loaded(class(x)[1],
-                   x$engine, x$user_specified_engine,
-                   x$mode, x$user_specified_mode)
+    spec_is_loaded(x)
 }
 
 # construct a message informing the user that there are no
@@ -158,10 +164,14 @@ is_printable_spec <- function(x) {
 #' @export
 #' @keywords internal
 #' @rdname add_on_exports
-prompt_missing_implementation <- function(cls,
-                                          engine, user_specified_engine,
-                                          mode, user_specified_mode,
+prompt_missing_implementation <- function(spec,
+                                          engine = spec$engine,
+                                          user_specified_engine = spec$user_specified_engine,
+                                          mode = spec$mode,
+                                          user_specified_mode = spec$user_specified_mode,
                                           prompt, ...) {
+  cls <- class(spec)[[1]]
+
   engine_condition <- engine_filter_condition(engine, user_specified_engine)
   mode_condition <- mode_filter_condition(mode, user_specified_mode)
 
@@ -303,18 +313,17 @@ new_model_spec <- function(cls, args, eng_args, mode, user_specified_mode = TRUE
   # determine if the model specification could feasibly match any entry
   # in the union of the parsnip model environment and model_info_table.
   # if not, trigger an error based on the (possibly inferred) model spec slots.
-  if (!spec_is_possible(cls,
-                        engine, user_specified_engine,
-                        mode, user_specified_mode)) {
-    check_spec_mode_engine_val(cls, engine, mode)
-  }
-
   out <- list(
     args = args, eng_args = eng_args,
     mode = mode, user_specified_mode = user_specified_mode, method = method,
     engine = engine, user_specified_engine = user_specified_engine
   )
   class(out) <- make_classes(cls)
+
+  if (!spec_is_possible(spec = out)) {
+    check_spec_mode_engine_val(cls, engine, mode)
+  }
+
   out
 }
 

R/print.R

@@ -9,13 +9,8 @@ print.model_spec <- function(x, ...) {
 #' @rdname add_on_exports
 #' @export
 print_model_spec <- function(x, cls = class(x)[1], desc = get_model_desc(cls), ...) {
-  if (!spec_is_loaded(cls,
-                      x$engine, x$user_specified_engine,
-                      x$mode, x$user_specified_mode)) {
-    prompt_missing_implementation(cls,
-                                  x$engine, x$user_specified_engine,
-                                  x$mode, x$user_specified_mode,
-                                  prompt = cli::cli_inform)
+  if (!spec_is_loaded(spec = structure(x, class = cls))) {
+    prompt_missing_implementation(spec = structure(x, class = cls), prompt = cli::cli_inform)
   }
 
   cat(desc, " Model Specification (", x$mode, ")\n\n", sep = "")