Refactor get_elements_by_type(), use pipe

and utility function remove_first_and_last_slash()

R/get_elements_by_type.R

@@ -25,28 +25,55 @@
 get_elements_by_type <- function(x, result = NULL, dbg = TRUE)
 {
   if (is.null(result)) {
-    kwb.utils::catAndRun(dbg = dbg, "Analysing the parse tree", {
-      result <- analyse(x)
-    })
+    kwb.utils::catAndRun(
+      "Analysing the parse tree", 
+      dbg = dbg, 
+      expr = {
+        result <- analyse(x)
+      }
+    )
   }
 
   type_paths <- get_paths_to_types(result)
 
-  code_parts <- lapply(type_paths, extract_by_path, x = x)
-
-  stats::setNames(code_parts, names(type_paths))
+  type_paths %>%
+    lapply(extract_by_path, x = x) %>%
+    stats::setNames(names(type_paths))
 }
 
 # extract_by_path --------------------------------------------------------------
 extract_by_path <- function(x, paths)
 {
-  # Remove leading slash from the type path
-  clean_paths <- gsub("^/", "", paths)
+  stopifnot(is.list(x))
+
+  paths %>%
+
+    # Split the path strings into vectors of integer
+    split_index_path() %>%
+
+    # Use the segments of the type path as (recursive) list indices
+    lapply(function(indices) {
+      if (length(indices)) {
+        x[[indices]]
+      }
+    })
+}
+
+# split_index_path -------------------------------------------------------------
+split_index_path <- function(x)
+{
+  stopifnot(is.character(x))
+  stopifnot(all(is_index_path(x)))
 
-  # Use the segments of the type path as (recursive) list indices
-  lapply(strsplit(clean_paths, "/"), function(indices) {
-    if (length(indices)) {
-      x[[as.integer(indices)]]
-    }
-  })
+  x %>%
+    remove_first_and_last_slash() %>%
+    strsplit("/") %>%
+    lapply(as.integer)
+}
+
+# is_index_path ----------------------------------------------------------------
+# @examples is_index_path(c("1", "/1", "/11", "1/2/3"))
+is_index_path <- function(x)
+{
+  grepl("^/?([0-9]+/?)+$", x)
 }

R/utils.R

@@ -90,6 +90,12 @@ is_what <- function(
   gsub("^is.", "", names(which(is_results)))
 }
 
+# remove_first_and_last_slash --------------------------------------------------
+remove_first_and_last_slash <- function(x)
+{
+  gsub("^/+|/+$", "", x)
+}
+
 # vector_to_count_table --------------------------------------------------------
 vector_to_count_table <- function(x)
 {

tests/testthat/test-function-extract_by_path.R

@@ -1,16 +1,28 @@
-#
-# This test file has been generated by kwb.test::create_test_files()
-# launched by user hauke on 2021-11-27 17:51:42.
-# Your are strongly encouraged to modify the dummy functions
-# so that real cases are tested. You should then delete this comment.
-#
+#library(testthat)
 
 test_that("extract_by_path() works", {
 
-  expect_error(
-    kwb.code:::extract_by_path()
-    # Argument "paths" fehlt (ohne Standardwert)
+  f <- kwb.code:::extract_by_path
+
+  expect_error(f())
+  expect_error(f("a"))
+
+  x <- list(
+    list( # [[1]]
+      11, 
+      12
+    ),
+    list( # [[2]]
+      21,
+      22,
+      list(
+        231,
+        232
+      )
+    )
   )
-
+
+  expect_identical(f(x, "1"), x[1L])
+  expect_identical(f(x, c("1", "2")), x[c(1, 2)])
+  expect_identical(f(x, c("/1/1", "2/2", "/2/3/2")), list(11, 22, 232))
 })
-