refactored read_data function

Author: douwe

R/read.R

@@ -78,23 +78,22 @@ read_keyvalue <- function(drfile, sheet, ranges, translate = FALSE, translations
 #' @noRd
 #'
 read_table <- function(drfile, sheet, ranges, translate = FALSE, translations = NULL, atomicclass = "character", ...) {
+  # Read and combine data from the specified ranges
   tbl <- lapply(ranges, function(range) {
-    readxl::read_excel(drfile, sheet = sheet, range = range)}) |>
-    dplyr::bind_rows()
+    readxl::read_excel(drfile, sheet = sheet, range = range)
+  }) |> dplyr::bind_rows()
 
+  # Coerce columns to the specified atomic class
   if (length(atomicclass) == 1) {
-    for (i in seq_along(tbl)) {
-      tbl[[i]] <- tbl[[i]] |> coerce(atomicclass)
-    }
+    tbl[] <- lapply(tbl, coerce, atomicclass)
   } else {
-    if (!length(atomicclass) == ncol(tbl)) {
+    if (length(atomicclass) != ncol(tbl)) {
       rlang::abort("The number of atomic classes must be 1 or equal to the number of columns in the table.")
     }
-    for (i in seq_along(atomicclass)) {
-      tbl[[i]] <- tbl[[i]] |> coerce(atomicclass[i])
-    }
+    tbl[] <- Map(coerce, tbl, atomicclass)
   }
 
+  # Translate column names if required
   if (translate) {
     names(tbl) <- long_to_shortnames(names(tbl), translations)
   }
@@ -187,80 +186,121 @@ short_to_longnames <- function(v, translations) {
 #' @export
 #'
 read_data <- function(drfile, guide, checkname = FALSE) {
-
+  # Load the guide if it's a file path
   if (inherits(guide, "character")) {
-    # If 'guide' is a file path then read the guide
     guide <- read_guide(guide)
-  } else {
-    if (! inherits(guide, "guide")) {
-      cl <- class(guide)
-      rlang::abort(glue::glue("The guide must be a path (character) to a guide file or a reporting template guide object (guide object), not an object of class {cl}."))
-    }
+  } else if (!inherits(guide, "guide")) {
+    rlang::abort(glue::glue(
+      "The guide must be a path (character) to a guide file or a reporting template guide object (guide object), not an object of class {class(guide)}."
+    ))
   }
 
   result <- list()
 
+  # Process each location in the guide
   for (location in guide$locations) {
     read_function <- switch(
       location$type,
       "keyvalue" = read_keyvalue,
       "table" = read_table,
-      "platedata" = read_key_plate
+      "platedata" = read_key_plate,
+      "cells" = read_cells,
+      rlang::abort(glue::glue("Unsupported location type: {location$type}"))
     )
 
-    atomicclass <- if ("atomicclass" %in% names(location)) location$atomicclass else "character"
-
-    if (!location$type == "cells") {
-      chunk <- read_function(drfile = drfile, sheet = location$sheet, ranges = location$ranges,
-                             translate = location$translate, translations = guide$translations,
-                             atomicclass = atomicclass)
-    } else {
-      chunk <- read_cells(drfile = drfile, sheet = location$sheet, variables = location$variables, translate = location$translate,
-                      translations = guide$translations, atomicclass = atomicclass)
-    }
+    atomicclass <- location$atomicclass %||% "character"
 
-    if (!(location$varname %in% names(result[[location$type]]))) {
-      result[[location$type]][[location$varname]] <- chunk
+    # Read data using the appropriate function
+    chunk <- if (location$type == "cells") {
+      read_function(
+        drfile = drfile,
+        sheet = location$sheet,
+        variables = location$variables,
+        translate = location$translate,
+        translations = guide$translations,
+        atomicclass = atomicclass
+      )
     } else {
-      result[[location$type]][[location$varname]] <- switch(
-        location$type,
-        "keyvalue" = c(result[[location$type]][[location$varname]], chunk),
-        "table" = dplyr::bind_rows(result[[location$type]][[location$varname]], chunk),
-        "platedata" = suppressMessages(dplyr::full_join(result[[location$type]][[location$varname]], chunk)),
-        "cells" = c(result[[location$type]][[location$varname]], chunk),
+      read_function(
+        drfile = drfile,
+        sheet = location$sheet,
+        ranges = location$ranges,
+        translate = location$translate,
+        translations = guide$translations,
+        atomicclass = atomicclass
       )
     }
+
+    # Combine results
+    result[[location$type]][[location$varname]] <- combine_results(
+      result[[location$type]][[location$varname]],
+      chunk,
+      location$type
+    )
   }
 
-  template.version <- result$cells$.template$version
-  if (grepl("^\\d+$", template.version)) {
-    template.version <- paste0(template.version, ".0")
-    rlang::warn(glue::glue("Incorrectly formatted template version number '{result$cells$.template$version}'. Version
-    numbers must have a minor number. Will interpret '{result$cells$.template$version}' as '{template.version}'."))
+  # Validate template version
+  validate_template_version(result$cells$.template$version, guide)
+
+  # Check template name if required
+  if (checkname && guide$template.name != result$template.metadata$template.name) {
+    rlang::abort(glue::glue(
+      "The name of the guide ({guide$template.name}) does not match the name of the excel template ({result$template.metadata$template.name})."
+    ))
   }
-  num.template.version <- package_version(template.version)
-  num.min.version <- package_version(guide$template.min.version)
 
-  if (num.template.version < num.min.version) {
-     rlang::abort(glue::glue("The guide is incompatible with the template.
-                             The template version should be minimally {guide$template.min.version}, whereas it is {result$template.metadata$template.version}."))
+  result$.sourcefile <- drfile
+  result$.guide <- guide
+  result
+}
+
+#' Helper function to combine results based on location type
+#' @param existing The existing data
+#' @param chunk The new data
+#' @param type The location type
+#' @noRd
+combine_results <- function(existing, chunk, type) {
+  if (is.null(existing)) {
+    return(chunk)
   }
 
-  if (!is.null(guide$template.max.version)) {
-    num.max.version <- package_version(guide$template.max.version)
-    if (num.max.version < num.template.version) {
-      rlang::abort(glue::glue("The guide is incompatible with the template.
-                              The template version should be maximally {guide$template.max.version}, whereas it is {result$template.metadata$template.version}."))
-    }
+  switch(
+    type,
+    "keyvalue" = c(existing, chunk),
+    "table" = dplyr::bind_rows(existing, chunk),
+    "platedata" = suppressMessages(dplyr::full_join(existing, chunk)),
+    "cells" = c(existing, chunk),
+    rlang::abort(glue::glue("Unsupported location type for combining results: {type}"))
+  )
+}
+
+#' Helper function to validate template
+#' @param template_version The version of the template
+#' @param guide The guide object
+#' @noRd
+validate_template_version <- function(template_version, guide) {
+  if (grepl("^\\d+$", template_version)) {
+    template_version <- paste0(template_version, ".0")
+    rlang::warn(glue::glue(
+      "Incorrectly formatted template version number '{template_version}'. Version numbers must have a minor number. Interpreting as '{template_version}'."
+    ))
   }
 
-  if (checkname) {
-    if (guide$template.name != result$template.metadata$template.name) {
-      rlang::abort(glue::glue("The name of the guide ({guide$template.name}) does not match the name of the excel template ({result$template.metadata$template.name})."))
-    }
+  num_template_version <- package_version(template_version)
+  num_min_version <- package_version(guide$template.min.version)
+
+  if (num_template_version < num_min_version) {
+    rlang::abort(glue::glue(
+      "The guide is incompatible with the template. The template version should be at least {guide$template.min.version}, but it is {template_version}."
+    ))
   }
 
-  result$.sourcefile <- drfile
-  result$.guide <- guide
-  result
+  if (!is.null(guide$template.max.version)) {
+    num_max_version <- package_version(guide$template.max.version)
+    if (num_template_version > num_max_version) {
+      rlang::abort(glue::glue(
+        "The guide is incompatible with the template. The template version should be at most {guide$template.max.version}, but it is {template_version}."
+      ))
+    }
+  }
 }