condense more classes

Author: wlandau

R/class_frames.R

@@ -4,9 +4,10 @@ frames_init <- function(imports = memory_init()) {
 }
 
 frames_new <- function(imports = NULL, targets = NULL) {
-  force(imports)
-  force(targets)
-  environment()
+  out <- new.env(parent = emptyenv(), hash = FALSE)
+  out$imports <- imports
+  out$targets <- targets
+  out
 }
 
 frames_get_envir <- function(frames) {

R/class_group.R

@@ -1,5 +1,7 @@
 group_new <- function(object = NULL) {
-  enclass(environment(), c("tar_group", "tar_value"))
+  out <- new.env(parent = emptyenv(), hash = FALSE)
+  out$object <- object
+  enclass(out, c("tar_group", "tar_value"))
 }
 
 #' @export

R/class_junction.R

@@ -10,10 +10,11 @@ junction_init <- function(
 }
 
 junction_new <- function(nexus = NULL, splits = NULL, deps = NULL) {
-  force(nexus)
-  force(splits)
-  force(deps)
-  environment()
+  out <- new.env(parent = emptyenv(), hash = FALSE)
+  out$nexus <- nexus
+  out$splits <- splits
+  out$deps <- deps
+  out
 }
 
 junction_upstream_edges <- function(junction) {

R/class_list.R

@@ -1,5 +1,7 @@
 list_new <- function(object = NULL) {
-  enclass(environment(), c("tar_list", "tar_value"))
+  out <- new.env(parent = emptyenv(), hash = FALSE)
+  out$object <- object
+  enclass(out, c("tar_list", "tar_value"))
 }
 
 #' @export

R/class_memory.R

@@ -4,10 +4,11 @@ memory_init <- function(envir = new.env(parent = emptyenv())) {
 }
 
 memory_new <- function(envir = NULL, names = NULL, count = NULL) {
-  force(envir)
-  force(names)
-  force(count)
-  environment()
+  out <- new.env(parent = emptyenv(), hash = FALSE)
+  out$envir <- envir
+  out$names <- names
+  out$count <- count
+  out
 }
 
 memory_exists_object <- function(memory, name) {

R/class_metrics.R

@@ -6,13 +6,14 @@ metrics_new <- function(
   traceback = NULL,
   cancel = NULL
 ) {
-  force(seconds)
-  force(warnings)
-  force(error)
-  force(error_class)
-  force(traceback)
-  force(cancel)
-  environment()
+  out <- new.env(parent = emptyenv(), hash = FALSE)
+  out$seconds <- seconds
+  out$warnings <- warnings
+  out$error <- error
+  out$error_class <- error_class
+  out$traceback <- traceback
+  out$cancel <- cancel
+  out
 }
 
 metrics_has_warnings <- function(metrics) {

R/class_pattern.R

@@ -6,13 +6,14 @@ pattern_new <- function(
   junction = NULL,
   patternview = NULL
 ) {
-  force(command)
-  force(settings)
-  force(cue)
-  force(value)
-  force(junction)
-  force(patternview)
-  enclass(environment(), c("tar_pattern", "tar_target"))
+  out <- new.env(parent = emptyenv(), hash = FALSE)
+  out$command <- command
+  out$settings <- settings
+  out$cue <- cue
+  out$value <- value
+  out$junction <- junction
+  out$patternview <- patternview
+  enclass(out, c("tar_pattern", "tar_target"))
 }
 
 #' @export

R/class_patternview.R

@@ -3,11 +3,11 @@ patternview_init <- function(seconds = 0, bytes = 0, progress = "queued") {
 }
 
 patternview_new <- function(seconds = 0, bytes = 0, progress = NULL) {
-  force(seconds)
-  force(bytes)
-  force(progress)
-  force(progress)
-  environment()
+  out <- new.env(parent = emptyenv(), hash = FALSE)
+  out$seconds <- seconds
+  out$bytes <- bytes
+  out$progress <- progress
+  out
 }
 
 patternview_register_meta <- function(patternview, record) {

R/class_pedigree.R

@@ -3,10 +3,11 @@ pedigree_init <- function(parent, child, index) {
 }
 
 pedigree_new <- function(parent = NULL, child = NULL, index = NULL) {
-  force(parent)
-  force(child)
-  force(index)
-  environment()
+  out <- new.env(parent = emptyenv(), hash = FALSE)
+  out$parent <- parent
+  out$child <- child
+  out$index <- index
+  out
 }
 
 pedigree_validate <- function(pedigree) {

R/class_pipeline.R

@@ -15,11 +15,12 @@ pipeline_new <- function(
   loaded = NULL,
   transient = NULL
 ) {
-  force(targets)
-  force(imports)
-  force(loaded)
-  force(transient)
-  enclass(environment(), "tar_pipeline")
+  out <- new.env(parent = emptyenv(), hash = FALSE)
+  out$targets <- targets
+  out$imports <- imports
+  out$loaded <- loaded
+  out$transient <- transient
+  enclass(out, "tar_pipeline")
 }
 
 pipeline_targets_init <- function(targets, clone_targets) {