Add Records container class

.Rbuildignore

@@ -11,3 +11,5 @@
 ^pkgdown$
 ^vignettes/*_files$
 ^vignettes/\.quarto$
+^doc$
+^Meta$

.gitignore

@@ -7,3 +7,5 @@
 
 experiments
 docs
+/doc/
+/Meta/

CHANGELOG.md

@@ -26,6 +26,8 @@ For more information, please visit the [package website](https://laminr.lamin.ai
 
 * Add `InstanceAPI$get_records()` and `Registry$df()` methods (PR #54)
 
+* Add a `RelatedRecords` class and `RelatedRecords$df()` method (PR #59)
+
 ## MAJOR CHANGES
 
 * Refactored the internal class data structures for better modularity and extensibility (PR #8).
@@ -84,10 +86,13 @@ For more information, please visit the [package website](https://laminr.lamin.ai
 
 * Add alternative error message when no message is returned from the API (PR #30).
 
+* Handle when error detail returned by the API is a list (PR #59)
+
 * Manually install OpenBLAS on macOS (PR #62).
 
 * Switch to Python 3.12 for being able to install scipy on macOS (PR #66).
 
+
 # laminr v0.0.1
 
 Initial POC implementation of the LaminDB API client for R.

R/InstanceAPI.R

@@ -42,6 +42,7 @@ InstanceAPI <- R6::R6Class( # nolint object_name_linter
     get_record = function(module_name,
                           registry_name,
                           id_or_uid,
+                          limit_to_many = 10,
                           include_foreign_keys = FALSE,
                           select = NULL,
                           verbose = FALSE) {
@@ -85,6 +86,8 @@ InstanceAPI <- R6::R6Class( # nolint object_name_linter
         id_or_uid,
         "?schema_id=",
         private$.instance_settings$schema_id,
+        "&limit_to_many=",
+        limit_to_many,
         "&include_foreign_keys=",
         tolower(include_foreign_keys)
       )
@@ -220,10 +223,17 @@ InstanceAPI <- R6::R6Class( # nolint object_name_linter
       content <- httr::content(response)
       if (httr::http_error(response)) {
         if (is.list(content) && "detail" %in% names(content)) {
-          cli_abort(content$detail)
+          detail <- content$detail
+          if (is.list(detail)) {
+            detail <- jsonlite::minify(jsonlite::toJSON(content$detail))
+          }
         } else {
-          cli_abort("Failed to {request_type} from instance. Output: {content}")
+          detail <- content
         }
+        cli_abort(c(
+          "Failed to {request_type} from instance",
+          "i" = "Details: {detail}"
+        ))
       }
 
       content

R/Record.R

@@ -153,6 +153,19 @@ Record <- R6::R6Class( # nolint object_name_linter
       } else if (key %in% private$.registry$get_field_names()) {
         field <- private$.registry$get_field(key)
 
+        # For many relationships return a RelatedRecords object
+        if (field$relation_type %in% c("one-to-many", "many-to-many")) {
+          records_list <- RelatedRecords$new(
+            instance = private$.instance,
+            registry = private$.registry,
+            field = field,
+            related_to = self$uid,
+            api = private$.api
+          )
+
+          return(records_list)
+        }
+
         # refetch the record to get the related data
         related_data <- private$.api$get_record(
           module_name = field$module_name,
@@ -171,12 +184,8 @@ Record <- R6::R6Class( # nolint object_name_linter
         related_registry <- related_module$get_registry(field$related_registry_name)
         related_registry_class <- related_registry$get_record_class()
 
-        # if the relation type is one-to-many or many-to-many, iterate over the list
-        if (field$relation_type %in% c("one-to-one", "many-to-one")) {
-          related_registry_class$new(related_data)
-        } else {
-          map(related_data, ~ related_registry_class$new(.x))
-        }
+        # Return the related record class
+        related_registry_class$new(related_data)
       } else {
         cli_abort(
           paste0(

R/RelatedRecords.R

@@ -0,0 +1,141 @@
+#' @title RelatedRecords
+#'
+#' @description
+#' A container for accessing records with a one-to-many or many-to-many
+#' relationship.
+RelatedRecords <- R6::R6Class( # nolint object_name_linter
+  "RelatedRecords",
+  cloneable = FALSE,
+  public = list(
+    #' @description
+    #' Creates an instance of this R6 class. This class should not be instantiated directly,
+    #' but rather by connecting to a LaminDB instance using the [connect()] function.
+    #'
+    #' @param instance The instance the records list belongs to.
+    #' @param registry The registry the records list belongs to.
+    #' @param field The field associated with the records list.
+    #' @param related_to ID or UID of the parent that records are related to.
+    #' @param api The API for the instance.
+    initialize = function(instance, registry, field, related_to, api) {
+      private$.instance <- instance
+      private$.registry <- registry
+      private$.api <- api
+      private$.field <- field
+      private$.related_to <- related_to
+    },
+    #' @description
+    #' Get a data frame summarising records in the registry
+    #'
+    #' @param limit Maximum number of records to return
+    #' @param verbose Boolean, whether to print progress messages
+    #'
+    #' @return A data.frame containing the available records
+    df = function(limit = 100, verbose = FALSE) {
+      private$get_records(as_df = TRUE)
+    },
+    #' @description
+    #' Print a `RelatedRecords`
+    #'
+    #' @param style Logical, whether the output is styled using ANSI codes
+    print = function(style = TRUE) {
+      cli::cat_line(self$to_string(style))
+    },
+    #' @description
+    #' Create a string representation of a `RelatedRecords`
+    #'
+    #' @param style Logical, whether the output is styled using ANSI codes
+    #'
+    #' @return A `cli::cli_ansi_string` if `style = TRUE` or a character vector
+    to_string = function(style = FALSE) {
+      fields <- list(
+        field_name = private$.field$field_name,
+        relation_type = private$.field$relation_type,
+        related_to = private$.related_to
+      )
+
+      field_strings <- make_key_value_strings(fields)
+
+      make_class_string(
+        "RelatedRecords", field_strings,
+        style = style
+      )
+    }
+  ),
+  active = list(
+    #' @field field ([Field])\cr
+    #' The field the records are related to.
+    field = function() {
+      private$.field
+    }
+  ),
+  private = list(
+    .instance = NULL,
+    .registry = NULL,
+    .api = NULL,
+    .field = NULL,
+    .related_to = NULL,
+    get_records = function(as_df = FALSE) {
+      field <- private$.field
+
+      # Fetch the field to get the related data
+      related_data <- private$.api$get_record(
+        module_name = field$module_name,
+        registry_name = field$registry_name,
+        id_or_uid = private$.related_to,
+        select = field$field_name,
+        limit_to_many = 100000L # Make this high to get all related records
+      )[[field$field_name]]
+
+      if (as_df) {
+        # Get field names so output always has the same order and empty output
+        # has column names
+        related_module <- private$.instance$get_module(field$related_module_name)
+        related_registry <- related_module$get_registry(field$related_registry_name)
+        related_fields <- related_registry$get_field_names()
+        # Remove hidden and link fields
+        is_hidden <- grepl("^_", related_fields)
+        is_link <- grepl("^links_", related_fields)
+        related_fields <- related_fields[!is_hidden & !is_link]
+
+        if (length(related_data) == 0) {
+          template_df <- as.data.frame(
+            matrix(
+              ncol = length(related_fields), nrow = 0,
+              dimnames = list(NULL, related_fields)
+            )
+          )
+
+          return(template_df)
+        }
+
+        values <- related_data |>
+          # Replace NULL with NA so columns aren't lost
+          purrr::modify_depth(2, \(x) ifelse(is.null(x), NA, x)) |>
+          # Convert each entry to a data.frame
+          purrr::map(as.data.frame) |>
+          # Bind entries as rows
+          purrr::list_rbind()
+
+        purrr::map(related_fields, function(.field) {
+          if (.field %in% colnames(values)) {
+            return(values[, .field, drop = FALSE])
+          } else {
+            column <- data.frame(rep(NA, nrow(values)))
+            colnames(column) <- .field
+            return(column)
+          }
+        }) |>
+          purrr::list_cbind()
+      } else {
+        # Get record class for records in the list
+        related_module <- private$.instance$get_module(field$related_module_name)
+        related_registry <- related_module$get_registry(field$related_registry_name)
+        related_registry_class <- related_registry$get_record_class()
+
+        values <- map(related_data, ~ related_registry_class$new(.x))
+      }
+
+      return(values)
+    }
+  )
+)

tests/testthat/test-RelatedRecords.R

@@ -0,0 +1,14 @@
+skip_if_offline()
+
+test_that("RelatedRecord methods work", {
+  local_setup_lamindata_instance()
+
+  db <- connect("laminlabs/lamindata")
+  artifact <- db$Artifact$get("mePviem4DGM4SFzvLXf3")
+  related <- artifact$experiments
+
+  expect_s3_class(related, "RelatedRecords")
+  expect_s3_class(related$df(), "data.frame")
+  expect_true(length(colnames(related$df())) > 0)
+  expect_s3_class(related$field, "Field")
+})

tests/testthat/test-connect_lamindata.R

@@ -22,6 +22,5 @@ test_that("Connecting to lamindata works", {
   # access a related field which is empty for this record
   expect_null(artifact$type) # one to one
 
-  expect_type(artifact$wells, "list") # one-to-many
-  expect_length(artifact$wells, 0)
+  expect_s3_class(artifact$wells, "RelatedRecords") # one-to-many
 })