Merge pull request #10 from RMI-PACTA/feat/2-parse-json-configs

merge lists

.lintr

@@ -1,4 +1,6 @@
-linters: all_linters()
+linters: all_linters(
+    cyclocomp_linter = cyclocomp_linter(complexity_limit = 18L)
+  )
 exclusions: list(
     "tests/testthat.R"
   )

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: pacta.workflow.utils
 Title: Utility functions for PACTA workflows
-Version: 0.0.0.9003
+Version: 0.0.0.9004
 Authors@R: 
     c(person(given = "Alex",
              family = "Axthelm",

R/merge_lists.R

@@ -0,0 +1,58 @@
+#' Merge two lists
+#'
+#' This function takes two lists (`base` and `overlay`), and merges them (by
+#' default recursively) into a single list. If a key is present in `overlay`,
+#' it is inherited from `overlay`, but keys missing in `overlay` will be
+#' inherited from `base`
+#'
+#' Code is heavily taken from the `merge` function in the `config` package.
+#' Notable differences between the two functions are:
+#' - This does not reorder keys in the lists
+#'
+#' @param base_list a named list
+#' @param overlay_list a named list
+#' @param recursive Should list be merged recurisvely, or only with top level
+#' keys?
+#'
+#' @return merged list
+merge_lists <- function(
+  base_list,
+  overlay_list,
+  recursive = TRUE
+) {
+  if (length(base_list) == 0L) {
+    log_trace("Base list is empty, returning overlay list")
+    overlay_list
+  } else if (length(overlay_list) == 0L) {
+    log_trace("Overlay list is empty, returning base list")
+    base_list
+  } else {
+
+    # Check for potential issues
+    if (!is.list(base_list) || !is.list(overlay_list)) {
+      log_error("Both base and overlay must be lists.")
+      log_error("Type of base_list: ", typeof(base_list))
+      log_error("Type of overlay_list: ", typeof(overlay_list))
+      stop("Both base and overlay must be lists.")
+    }
+    combined_lists <- c(base_list, overlay_list)
+    if (is.null(names(combined_lists)) || any(names(combined_lists) == "")) {
+      log_error("Lists must be named.")
+      stop("Lists must be named.")
+    }
+
+    # begin merging logic
+    merged_list <- base_list
+    for (name in names(overlay_list)) {
+      base <- base_list[[name]]
+      overlay <- overlay_list[[name]]
+      if (is.list(base) && is.list(overlay) && recursive) {
+        merged_list[[name]] <- merge_lists(base, overlay)
+      } else {
+        overlay_object <- overlay_list[[which(names(overlay_list) %in% name)]]
+        merged_list[[name]] <- overlay_object
+      }
+    }
+    return(merged_list)
+  }
+}

tests/testthat/test-merge_lists.R

@@ -0,0 +1,277 @@
+## save current settings so that we can reset later
+threshold <- logger::log_threshold()
+appender  <- logger::log_appender()
+layout    <- logger::log_layout()
+on.exit({
+  ## reset logger settings
+  logger::log_threshold(threshold)
+  logger::log_layout(layout)
+  logger::log_appender(appender)
+})
+
+logger::log_appender(logger::appender_stdout)
+logger::log_threshold(logger::FATAL)
+logger::log_layout(logger::layout_simple)
+
+simple_list <- list(
+  a = 1L,
+  b = "base string",
+  c = list(
+    d = 2L,
+    e = "another base string"
+  )
+)
+
+test_that("Merging empty overlay returns base list", {
+  overlay <- list()
+  result <- merge_lists(
+    base_list = simple_list,
+    overlay_list = overlay
+  )
+  testthat::expect_identical(
+    object = result,
+    expected = simple_list
+  )
+})
+
+test_that("Merging empty base returns overlay list", {
+  base <- list()
+  overlay <- simple_list
+  result <- merge_lists(
+    base_list = base,
+    overlay_list = overlay
+  )
+  testthat::expect_identical(
+    object = result,
+    expected = overlay
+  )
+})
+
+test_that("Merging NULL overlay returns base list", {
+  overlay <- NULL
+  result <- merge_lists(
+    base_list = simple_list,
+    overlay_list = overlay
+  )
+  testthat::expect_identical(
+    object = result,
+    expected = simple_list
+  )
+})
+
+test_that("Merging NULL base returns overlay list", {
+  base <- NULL
+  overlay <- simple_list
+  result <- merge_lists(
+    base_list = base,
+    overlay_list = overlay
+  )
+  testthat::expect_identical(
+    object = result,
+    expected = overlay
+  )
+})
+
+test_that("Merging top level keys works", {
+  overlay <- list(b = "overlay string")
+  result <- merge_lists(
+    base_list = simple_list,
+    overlay_list = overlay
+  )
+  testthat::expect_identical(
+    object = result,
+    expected = list(
+      a = 1L,
+      b = "overlay string",
+      c = list(
+        d = 2L,
+        e = "another base string"
+      )
+    )
+  )
+})
+
+test_that("Merging top level keys works, no recursion", {
+  overlay <- list(b = "overlay string")
+  result <- merge_lists(
+    base_list = simple_list,
+    overlay_list = overlay,
+    recursive = FALSE
+  )
+  testthat::expect_identical(
+    object = result,
+    expected = list(
+      a = 1L,
+      b = "overlay string",
+      c = list(
+        d = 2L,
+        e = "another base string"
+      )
+    )
+  )
+})
+
+test_that("Merging a vector can replace a list", {
+  overlay <- list(c = letters[1L:5L])
+  result <- merge_lists(
+    base_list = simple_list,
+    overlay_list = overlay,
+    recursive = FALSE
+  )
+  testthat::expect_identical(
+    object = result,
+    expected = list(
+      a = 1L,
+      b = "base string",
+      c = c("a", "b", "c", "d", "e")
+    )
+  )
+})
+
+test_that("Merging non-intersecting lists works", {
+  overlay <- list(
+    x = "overlay string",
+    y = 1.5,
+    z = list(
+      v = 1L,
+      w = "string"
+    )
+  )
+  result <- merge_lists(
+    base_list = simple_list,
+    overlay_list = overlay,
+    recursive = FALSE
+  )
+  testthat::expect_identical(
+    object = result,
+    expected = list(
+      a = 1L,
+      b = "base string",
+      c = list(
+        d = 2L,
+        e = "another base string"
+      ),
+      x = "overlay string",
+      y = 1.5,
+      z = list(
+        v = 1L,
+        w = "string"
+      )
+    )
+  )
+})
+
+test_that("Merging nested non-intersecting keys works", {
+  overlay <- list(c = list(f = "overlay_string"))
+  result <- merge_lists(
+    base_list = simple_list,
+    overlay_list = overlay
+  )
+  testthat::expect_identical(
+    object = result,
+    expected = list(
+      a = 1L,
+      b = "base string",
+      c = list(
+        d = 2L,
+        e = "another base string",
+        f = "overlay_string"
+      )
+    )
+  )
+})
+
+test_that("Merging nested non-intersecting keys replaces with no recursion", {
+  overlay <- list(c = list(f = "overlay string"))
+  result <- merge_lists(
+    base_list = simple_list,
+    overlay_list = overlay,
+    recursive = FALSE
+  )
+  testthat::expect_identical(
+    object = result,
+    expected = list(
+      a = 1L,
+      b = "base string",
+      c = list(
+        f = "overlay string"
+      )
+    )
+  )
+})
+
+test_that("Merging nested intersecting keys works", {
+  overlay <- list(c = list(e = "overlay string"))
+  result <- merge_lists(
+    base_list = simple_list,
+    overlay_list = overlay
+  )
+  testthat::expect_identical(
+    object = result,
+    expected = list(
+      a = 1L,
+      b = "base string",
+      c = list(
+        d = 2L,
+        e = "overlay string"
+      )
+    )
+  )
+})
+
+test_that("Unnamed lists throw errors - Base", {
+  base <- list("foo", "bar", "baz")
+  testthat::expect_error(
+    object = merge_lists(
+      base_list = base,
+      overlay_list = simple_list
+    ),
+    regexp = "^Lists must be named.$"
+  )
+})
+
+test_that("Unnamed lists throw errors - Overlay", {
+  overlay <- list("qux", "quux")
+  testthat::expect_error(
+    object = merge_lists(
+      base_list = simple_list,
+      overlay_list = overlay
+    ),
+    regexp = "^Lists must be named.$"
+  )
+})
+
+test_that("Unnamed lists throw errors - Both", {
+  base <- list("foo", "bar", "baz")
+  overlay <- list("qux", "quux")
+  testthat::expect_error(
+    object = merge_lists(
+      base_list = base,
+      overlay_list = overlay
+    ),
+    regexp = "^Lists must be named.$"
+  )
+})
+
+test_that("Unnamed lists throw errors - Partial naming", {
+  overlay <- list(a = "qux", b = "quux", "foo", "bar")
+  testthat::expect_error(
+    object = merge_lists(
+      base_list = simple_list,
+      overlay_list = overlay
+    ),
+    regexp = "^Lists must be named.$"
+  )
+})
+
+test_that("Vectors are not acceptable inputs", {
+  base <- c(a = "foo", b = "bar", c = "baz")
+  overlay <- c(a = "qux", d = "quux")
+  testthat::expect_error(
+    object = merge_lists(
+      base_list = base,
+      overlay_list = overlay
+    ),
+    regexp = "^Both base and overlay must be lists.$"
+  )
+})