From dfde03593b1510e99e33dadbaac85fd143a0ddba Mon Sep 17 00:00:00 2001
From: simonpcouch <simonpatrickcouch@gmail.com>
Date: Thu, 24 Oct 2024 08:41:01 -0500
Subject: [PATCH 1/3] workshop protected arguments warning

---
 R/arguments.R                         |  9 ++++---
 tests/testthat/_snaps/arguments.md    | 25 ++++++++++++++++++
 tests/testthat/_snaps/mlp.md          | 19 --------------
 tests/testthat/_snaps/multinom_reg.md | 20 ---------------
 tests/testthat/_snaps/nullmodel.md    | 16 ------------
 tests/testthat/test-arguments.R       | 37 +++++++++++++++++++++++++++
 tests/testthat/test-mlp.R             |  5 +++-
 tests/testthat/test-multinom_reg.R    | 13 +++++++---
 tests/testthat/test-nullmodel.R       |  5 ++--
 9 files changed, 83 insertions(+), 66 deletions(-)
 create mode 100644 tests/testthat/_snaps/arguments.md
 create mode 100644 tests/testthat/test-arguments.R

diff --git a/R/arguments.R b/R/arguments.R
index 3142ce35a..82fee0355 100644
--- a/R/arguments.R
+++ b/R/arguments.R
@@ -20,11 +20,12 @@ check_eng_args <- function(args, obj, core_args) {
   protected_args <- unique(c(obj$protect, core_args))
   common_args <- intersect(protected_args, names(args))
   if (length(common_args) > 0) {
-    args <- args[!(names(args) %in% common_args)]
-    common_args <- paste0(common_args, collapse = ", ")
     cli::cli_warn(
-      "The argument{?s} {.arg {common_args}} cannot be manually
-       modified and {?was/were} removed."
+      c(
+        "The argument{?s} {.arg {common_args}} cannot be manually modified
+         and {?was/were} removed."
+      ),
+      class = "parsnip_protected_arg_warning"
     )
   }
   args
diff --git a/tests/testthat/_snaps/arguments.md b/tests/testthat/_snaps/arguments.md
new file mode 100644
index 000000000..e7d455681
--- /dev/null
+++ b/tests/testthat/_snaps/arguments.md
@@ -0,0 +1,25 @@
+# warns informatively about protected arguments
+
+    Code
+      .res <- check_eng_args(args = list(a = 1, b = 2, c = 3, e = 5), obj = obj,
+      core_args = core_args)
+    Condition
+      Warning:
+      The arguments `a`, `b`, and `c` cannot be manually modified and were removed.
+
+---
+
+    Code
+      .res <- check_eng_args(args = list(b = 2, c = 3, e = 5), obj = obj, core_args = core_args)
+    Condition
+      Warning:
+      The arguments `b` and `c` cannot be manually modified and were removed.
+
+---
+
+    Code
+      .res <- check_eng_args(args = list(c = 3, e = 5), obj = obj, core_args = core_args)
+    Condition
+      Warning:
+      The argument `c` cannot be manually modified and was removed.
+
diff --git a/tests/testthat/_snaps/mlp.md b/tests/testthat/_snaps/mlp.md
index 5039e1625..2ab34ced0 100644
--- a/tests/testthat/_snaps/mlp.md
+++ b/tests/testthat/_snaps/mlp.md
@@ -32,25 +32,6 @@
       x Engine "wat?" is not supported for `mlp()`
       i See `show_engines("mlp")`.
 
----
-
-    Code
-      translate(mlp(mode = "regression") %>% set_engine("nnet", formula = y ~ x))
-    Condition
-      Warning:
-      The argument `formula` cannot be manually modified and was removed.
-    Output
-      Single Layer Neural Network Model Specification (regression)
-      
-      Main Arguments:
-        hidden_units = 5
-      
-      Computational engine: nnet 
-      
-      Model fit template:
-      nnet::nnet(formula = missing_arg(), data = missing_arg(), size = 5, 
-          trace = FALSE, linout = TRUE)
-
 # check_args() works
 
     Code
diff --git a/tests/testthat/_snaps/multinom_reg.md b/tests/testthat/_snaps/multinom_reg.md
index 32dcdad41..78d2ef3ad 100644
--- a/tests/testthat/_snaps/multinom_reg.md
+++ b/tests/testthat/_snaps/multinom_reg.md
@@ -40,26 +40,6 @@
       Error in `set_engine()`:
       ! Missing engine. Possible mode/engine combinations are: classification {glmnet, spark, keras, nnet, brulee}.
 
----
-
-    Code
-      translate(multinom_reg(penalty = 0.1) %>% set_engine("glmnet", x = hpc[, 1:3],
-      y = hpc$class))
-    Condition
-      Warning:
-      The argument `x, y` cannot be manually modified and was removed.
-    Output
-      Multinomial Regression Model Specification (classification)
-      
-      Main Arguments:
-        penalty = 0.1
-      
-      Computational engine: glmnet 
-      
-      Model fit template:
-      glmnet::glmnet(x = missing_arg(), y = missing_arg(), weights = missing_arg(), 
-          family = "multinomial")
-
 # check_args() works
 
     Code
diff --git a/tests/testthat/_snaps/nullmodel.md b/tests/testthat/_snaps/nullmodel.md
index 1194617c6..79ac405b1 100644
--- a/tests/testthat/_snaps/nullmodel.md
+++ b/tests/testthat/_snaps/nullmodel.md
@@ -15,22 +15,6 @@
       x Engine "wat?" is not supported for `null_model()`
       i See `show_engines("null_model")`.
 
----
-
-    Code
-      translate(null_model(mode = "regression") %>% set_engine("parsnip", x = hpc[, 1:
-        3], y = hpc$class))
-    Condition
-      Warning:
-      The argument `x, y` cannot be manually modified and was removed.
-    Output
-      Null Model Specification (regression)
-      
-      Computational engine: parsnip 
-      
-      Model fit template:
-      parsnip::nullmodel(x = missing_arg(), y = missing_arg())
-
 # nullmodel execution
 
     Code
diff --git a/tests/testthat/test-arguments.R b/tests/testthat/test-arguments.R
new file mode 100644
index 000000000..2adb31974
--- /dev/null
+++ b/tests/testthat/test-arguments.R
@@ -0,0 +1,37 @@
+test_that("warns informatively about protected arguments", {
+  obj <- list(protect = c("a", "b"))
+  core_args <- c("c", "d")
+
+  expect_snapshot(
+    .res <- check_eng_args(
+      args = list(a = 1, b = 2, c = 3, e = 5),
+      obj = obj,
+      core_args = core_args
+    )
+  )
+
+  expect_snapshot(
+    .res <- check_eng_args(
+      args = list(b = 2, c = 3, e = 5),
+      obj = obj,
+      core_args = core_args
+    )
+  )
+
+  expect_snapshot(
+    .res <- check_eng_args(
+      args = list(c = 3, e = 5),
+      obj = obj,
+      core_args = core_args
+    )
+  )
+
+  expect_warning(
+    check_eng_args(
+      args = list(a = 1, b = 2, c = 3, e = 5),
+      obj = obj,
+      core_args = core_args
+    ),
+    class = "parsnip_protected_arg_warning"
+  )
+})
diff --git a/tests/testthat/test-mlp.R b/tests/testthat/test-mlp.R
index c943193db..6ce032d74 100644
--- a/tests/testthat/test-mlp.R
+++ b/tests/testthat/test-mlp.R
@@ -11,7 +11,10 @@ test_that('updating', {
 test_that('bad input', {
   expect_snapshot(error = TRUE, mlp(mode = "time series"))
   expect_snapshot(error = TRUE, translate(mlp(mode = "classification") %>% set_engine("wat?")))
-  expect_snapshot(translate(mlp(mode = "regression") %>% set_engine("nnet", formula = y ~ x)))
+  expect_warning(
+    translate(mlp(mode = "regression") %>% set_engine("nnet", formula = y ~ x)),
+    class = "parsnip_protected_arg_warning"
+  )
 })
 
 test_that("nnet_softmax", {
diff --git a/tests/testthat/test-multinom_reg.R b/tests/testthat/test-multinom_reg.R
index 970d52fef..748367f81 100644
--- a/tests/testthat/test-multinom_reg.R
+++ b/tests/testthat/test-multinom_reg.R
@@ -13,16 +13,21 @@ test_that('bad input', {
   expect_snapshot(error = TRUE, multinom_reg(mode = "regression"))
   expect_snapshot(error = TRUE, translate(multinom_reg(penalty = 0.1) %>% set_engine("wat?")))
   expect_snapshot(error = TRUE, multinom_reg(penalty = 0.1) %>% set_engine())
-  expect_snapshot(translate(multinom_reg(penalty = 0.1) %>% set_engine("glmnet", x = hpc[,1:3], y = hpc$class)))
+  expect_warning(
+    translate(
+      multinom_reg(penalty = 0.1) %>% set_engine("glmnet", x = hpc[,1:3], y = hpc$class)
+    ),
+    class = "parsnip_protected_arg_warning"
+  )
 })
 
 test_that('check_args() works', {
   skip_if_not_installed("keras")
-  
+
   expect_snapshot(
     error = TRUE,
     {
-      spec <- multinom_reg(mixture = -1) %>% 
+      spec <- multinom_reg(mixture = -1) %>%
         set_engine("keras") %>%
         set_mode("classification")
       fit(spec, class ~ ., hpc)
@@ -31,7 +36,7 @@ test_that('check_args() works', {
   expect_snapshot(
     error = TRUE,
     {
-      spec <- multinom_reg(penalty = -1) %>% 
+      spec <- multinom_reg(penalty = -1) %>%
         set_engine("keras") %>%
         set_mode("classification")
       fit(spec, class ~ ., hpc)
diff --git a/tests/testthat/test-nullmodel.R b/tests/testthat/test-nullmodel.R
index 05358ab0a..03a2920b1 100644
--- a/tests/testthat/test-nullmodel.R
+++ b/tests/testthat/test-nullmodel.R
@@ -3,10 +3,11 @@ hpc <- hpc_data[1:150, c(2:5, 8)] %>% as.data.frame()
 test_that('bad input', {
   expect_snapshot(error = TRUE, translate(null_model(mode = "regression") %>% set_engine()))
   expect_snapshot(error = TRUE, translate(null_model() %>% set_engine("wat?")))
-  expect_snapshot(
+  expect_warning(
     translate(
       null_model(mode = "regression") %>% set_engine("parsnip", x = hpc[,1:3], y = hpc$class)
-    )
+    ),
+    class = "parsnip_protected_arg_warning"
   )
 })
 

From 7c0de55bfaf8058ac1a6edeff02b7b7b5d3daf7c Mon Sep 17 00:00:00 2001
From: simonpcouch <simonpatrickcouch@gmail.com>
Date: Fri, 25 Oct 2024 14:15:41 -0500
Subject: [PATCH 2/3] reintroduce removal of protected arguments

---
 R/arguments.R | 1 +
 1 file changed, 1 insertion(+)

diff --git a/R/arguments.R b/R/arguments.R
index 82fee0355..a76ea85ed 100644
--- a/R/arguments.R
+++ b/R/arguments.R
@@ -20,6 +20,7 @@ check_eng_args <- function(args, obj, core_args) {
   protected_args <- unique(c(obj$protect, core_args))
   common_args <- intersect(protected_args, names(args))
   if (length(common_args) > 0) {
+    args <- args[!(names(args) %in% common_args)]
     cli::cli_warn(
       c(
         "The argument{?s} {.arg {common_args}} cannot be manually modified

From 34756abdc6fc4a7c959e962bfea1b1066c00496d Mon Sep 17 00:00:00 2001
From: simonpcouch <simonpatrickcouch@gmail.com>
Date: Fri, 25 Oct 2024 14:15:58 -0500
Subject: [PATCH 3/3] test that protected arguments are indeed removed when
 provided

---
 tests/testthat/test-arguments.R | 6 ++++++
 1 file changed, 6 insertions(+)

diff --git a/tests/testthat/test-arguments.R b/tests/testthat/test-arguments.R
index 2adb31974..31c176814 100644
--- a/tests/testthat/test-arguments.R
+++ b/tests/testthat/test-arguments.R
@@ -10,6 +10,8 @@ test_that("warns informatively about protected arguments", {
     )
   )
 
+  expect_named(.res, "e")
+
   expect_snapshot(
     .res <- check_eng_args(
       args = list(b = 2, c = 3, e = 5),
@@ -18,6 +20,8 @@ test_that("warns informatively about protected arguments", {
     )
   )
 
+  expect_named(.res, "e")
+
   expect_snapshot(
     .res <- check_eng_args(
       args = list(c = 3, e = 5),
@@ -26,6 +30,8 @@ test_that("warns informatively about protected arguments", {
     )
   )
 
+  expect_named(.res, "e")
+
   expect_warning(
     check_eng_args(
       args = list(a = 1, b = 2, c = 3, e = 5),