tarchetypes compatibility

R/class_branch.R

@@ -5,7 +5,8 @@ branch_init <- function(
   deps_child = character(0L),
   settings = NULL,
   cue = NULL,
-  store = NULL
+  store = NULL,
+  index = NULL
 ) {
   deps <- setdiff(unique(c(deps_parent, deps_child)), settings$dimensions)
   branch_new(
@@ -16,7 +17,8 @@ branch_init <- function(
     settings = settings,
     cue = cue,
     store = store,
-    file = file_init()
+    file = file_init(),
+    index = index
   )
 }
 
@@ -28,7 +30,8 @@ branch_new <- function(
   settings = NULL,
   cue = NULL,
   store = NULL,
-  file = NULL
+  file = NULL,
+  index = NULL
 ) {
   out <- new.env(parent = emptyenv(), hash = FALSE)
   out$name <- name
@@ -39,6 +42,7 @@ branch_new <- function(
   out$cue <- cue
   out$store <- store
   out$file <- file
+  out$index <- index
   enclass(out, branch_s3_class)
 }
 
@@ -96,6 +100,10 @@ target_validate.tar_branch <- function(target) {
   tar_assert_chr(target$deps)
   store_validate(target$store)
   file_validate(target$file)
+  tar_assert_int(target$index)
+  tar_assert_scalar(target$index)
+  tar_assert_finite(target$index)
+  tar_assert_ge(target$index, 1L)
 }
 
 #' @export

R/class_pattern.R

@@ -254,15 +254,17 @@ pattern_set_branches <- function(target, pipeline) {
   cue <- target$cue
   store <- target$store
   specs <- junction_transpose(target$junction)
-  for (spec in specs) {
+  for (index in seq_along(specs)) {
+    spec <- .subset2(specs, index)
     branch <- branch_init(
       name = .subset2(spec, "split"),
       command = command,
       deps_parent = deps_parent,
       deps_child = .subset2(spec, "deps"),
       settings = settings,
       cue = cue,
-      store = store
+      store = store,
+      index = index
     )
     pipeline_set_target(pipeline, branch)
   }

tests/testthat/test-class_branch.R

@@ -8,7 +8,8 @@ tar_test("branch creation", {
     deps_parent = character(0L),
     deps_child = character(0L),
     settings = settings,
-    cue = cue
+    cue = cue,
+    index = 1L
   )
   expect_true(inherits(branch, "tar_branch"))
 })
@@ -23,7 +24,8 @@ tar_test("branch name vs parent name", {
     deps_parent = character(0L),
     deps_child = character(0L),
     settings = settings,
-    cue = cue
+    cue = cue,
+    index = 1L
   )
   expect_equal(settings$name, "x")
   expect_equal(branch$settings$name, "x")
@@ -46,7 +48,8 @@ tar_test("branch priority", {
     deps_parent = character(0L),
     deps_child = character(0L),
     settings = settings,
-    cue = cue
+    cue = cue,
+    index = 1L
   )
   expect_equal(branch$settings$priority, 0.5)
 })
@@ -61,7 +64,8 @@ tar_test("branches are not branchable", {
     deps_parent = character(0L),
     deps_child = character(0L),
     settings = settings,
-    cue = cue
+    cue = cue,
+    index = 1L
   )
   expect_false(target_is_branchable(branch))
 })
@@ -76,7 +80,8 @@ tar_test("target_get_name()", {
     deps_parent = character(0L),
     deps_child = character(0L),
     settings = settings,
-    cue = cue
+    cue = cue,
+    index = 1L
   )
   expect_equal(settings$name, "x")
   expect_equal(target_get_name(branch), "y")
@@ -92,7 +97,8 @@ tar_test("target_get_parent(branch)", {
     deps_parent = character(0L),
     deps_child = character(0L),
     settings = settings,
-    cue = cue
+    cue = cue,
+    index = 1L
   )
   expect_equal(target_get_parent(branch), "x")
 })
@@ -165,7 +171,8 @@ tar_test("branch_validate()", {
     deps_child = character(0L),
     settings = settings,
     cue = cue,
-    store = settings_produce_store(settings)
+    store = settings_produce_store(settings),
+    index = 1L
   )
   expect_silent(target_validate(branch))
 })