Add Records container class (#59)

* Add RecordsList class

* Rename RecordsList to RelatedRecords

* Add tests for RelatedRecords

* Add limit_to_many to API$get_record()

* Handle when error detail is a list in API

* Order columns and return empty in RelatedRecords$df()

* Add RelatedRecords to usage vignette

And other fixes/additions

* Add RelatedRecords tests

* Update CHANGELOG

* change the flow of the `get_value` function

* Add RelatedRecords to architecture.qmd

Plus various tidying/adjustments

* Add missing Core --> Artifact link

* Add more info about artifact

* style vignette

* Move Artifact to inherit from Record in diagram

* Remove Field accessor from RelatedRecords

* Remove Field from RelatedRecords test

* Replace Quarto callout with Bootstrap alert box

---------

Co-authored-by: Robrecht Cannoodt <[email protected]>

.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).
@@ -94,10 +96,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

@@ -148,43 +148,57 @@ Record <- R6::R6Class( # nolint object_name_linter
     .api = NULL,
     .data = NULL,
     get_value = function(key) {
+      # Return the value if it is in the data
       if (key %in% names(private$.data)) {
-        private$.data[[key]]
-      } else if (key %in% private$.registry$get_field_names()) {
-        field <- private$.registry$get_field(key)
-
-        # refetch the record 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$.data[["uid"]],
-          select = key
-        )[[key]]
-
-        # return NULL if the related data is NULL
-        if (is.null(related_data)) {
-          return(NULL)
-        }
-
-        # if the related data is not NULL, create a record class for it
-        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()
-
-        # 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))
-        }
-      } else {
+        return(private$.data[[key]])
+      }
+
+      # If the key is not in the data, check if it is a field in the registry
+      if (!key %in% private$.registry$get_field_names()) {
         cli_abort(
           paste0(
             "Field '", key, "' not found in registry '",
             private$.registry$name, "'"
           )
         )
       }
+
+      # Get the field from the registry
+      field <- private$.registry$get_field(key)
+
+      # For *-to-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,
+        registry_name = field$registry_name,
+        id_or_uid = private$.data[["uid"]],
+        select = key
+      )[[key]]
+
+      # return NULL if the related data is NULL
+      if (is.null(related_data)) {
+        return(NULL)
+      }
+
+      # if the related data is not NULL, create a record class for it
+      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()
+
+      # Return the related record class
+      related_registry_class$new(related_data)
     }
   )
 )

R/RelatedRecords.R

@@ -0,0 +1,134 @@
+#' @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
+      )
+    }
+  ),
+  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)
+    }
+  )
+)