Merge pull request #291 from tidymodels/s3-register-tidy

S3 register tidy method for R 4.0

Author: topepo

.github/workflows/R-CMD-check.yaml

@@ -13,6 +13,7 @@ jobs:
       matrix:
         config:
         - { os: windows-latest, r: '3.6'}
+        - { os: windows-latest, r: '4.0'}
         - { os: windows-latest, r: 'devel'}
         - { os: ubuntu-16.04, r: '3.5', cran: "https://demo.rstudiopm.com/all/__linux__/xenial/latest"}
         - { os: ubuntu-16.04, r: '3.6', cran: "https://demo.rstudiopm.com/all/__linux__/xenial/latest"}

NEWS.md

@@ -2,7 +2,9 @@
 
 # parsnip 0.0.5.9000
 
+## Other Changes
 
+* S3 dispatch for `tidy()` was broken on R 4.0. 
 
 # parsnip 0.0.5
 

R/zzz.R

@@ -1,3 +1,73 @@
+# nocov start
+
+.onLoad <- function(libname, pkgname) {
+  s3_register("broom::tidy", "model_fit")
+}
+
+
+# vctrs:::s3_register()
+s3_register <- function(generic, class, method = NULL) {
+  stopifnot(is.character(generic), length(generic) == 1)
+  stopifnot(is.character(class), length(class) == 1)
+
+  pieces <- strsplit(generic, "::")[[1]]
+  stopifnot(length(pieces) == 2)
+  package <- pieces[[1]]
+  generic <- pieces[[2]]
+
+  caller <- parent.frame()
+
+  get_method_env <- function() {
+    top <- topenv(caller)
+    if (isNamespace(top)) {
+      asNamespace(environmentName(top))
+    } else {
+      caller
+    }
+  }
+  get_method <- function(method, env) {
+    if (is.null(method)) {
+      get(paste0(generic, ".", class), envir = get_method_env())
+    } else {
+      method
+    }
+  }
+
+  method_fn <- get_method(method)
+  stopifnot(is.function(method_fn))
+
+  # Always register hook in case package is later unloaded & reloaded
+  setHook(
+    packageEvent(package, "onLoad"),
+    function(...) {
+      ns <- asNamespace(package)
+
+      # Refresh the method, it might have been updated by `devtools::load_all()`
+      method_fn <- get_method(method)
+
+      registerS3method(generic, class, method_fn, envir = ns)
+    }
+  )
+
+  # Avoid registration failures during loading (pkgload or regular)
+  if (!isNamespaceLoaded(package)) {
+    return(invisible())
+  }
+
+  envir <- asNamespace(package)
+
+  # Only register if generic can be accessed
+  if (exists(generic, envir)) {
+    registerS3method(generic, class, method_fn, envir = envir)
+  }
+
+  invisible()
+}
+
+# nocov end
+
+
+
 #' ## nocov start
 #'
 #' data_obj <- ls(pattern = "_data$")