Modify Registry$print() to show fields by module (#71)

* Modify Registry$print() to show fields by module * Modify Registry$to_string() to have module fields * Update CHANGELOG * minor refactoring of print and to_string * add test for to_string * update test * update namespace * fix purrr imports --------- Co-authored-by: Robrecht Cannoodt <[email protected]>
laminlabs · Nov 1, 2024 · 84c1f89 · 84c1f89
1 parent f73467f
commit 84c1f89
Show file tree

Hide file tree

Showing 11 changed files with 175 additions and 67 deletions.
diff --git a/CHANGELOG.md b/CHANGELOG.md
@@ -46,6 +46,8 @@ For more information, please visit the [package website](https://laminr.lamin.ai
 
 * Adjust colours in print output (PR #69)
 
+* Modify `Registry` print output to separate relational fields by module (PR #71)
+
 ## TESTING
 
 - Add a simple unit test which queries laminlabs/lamindata (PR #27).

diff --git a/NAMESPACE b/NAMESPACE
@@ -12,10 +12,17 @@ importFrom(httr,content)
 importFrom(jsonlite,toJSON)
 importFrom(purrr,discard)
 importFrom(purrr,keep)
+importFrom(purrr,list_c)
+importFrom(purrr,list_cbind)
 importFrom(purrr,list_flatten)
+importFrom(purrr,list_rbind)
 importFrom(purrr,map)
 importFrom(purrr,map2)
 importFrom(purrr,map_chr)
+importFrom(purrr,map_lgl)
+importFrom(purrr,modify_depth)
 importFrom(purrr,pmap)
+importFrom(purrr,reduce)
 importFrom(purrr,set_names)
 importFrom(purrr,transpose)
+importFrom(purrr,walk)
diff --git a/R/Artifact.R b/R/Artifact.R
@@ -64,7 +64,7 @@ ArtifactRecord <- R6::R6Class( # nolint object_name_linter
 
       output_strings <- character()
 
-      provenance_strings <- purrr::map_chr(
+      provenance_strings <- map_chr(
         names(provenance_fields),
         function(.field) {
           field_name <- try(self[[.field]][[provenance_fields[.field]]])
@@ -79,7 +79,7 @@ ArtifactRecord <- R6::R6Class( # nolint object_name_linter
           paste0("    $", .field, " = ", field_name)
         }
       ) |>
-        purrr::discard(is.na)
+        discard(is.na)
 
       if (length(provenance_strings) > 0) {
         output_strings <- c(

diff --git a/R/Instance.R b/R/Instance.R
@@ -165,10 +165,10 @@ Instance <- R6::R6Class( # nolint object_name_linter
     print = function(style = TRUE) {
       registries <- self$get_module("core")$get_registries()
 
-      is_link_table <- purrr::map(registries, "is_link_table") |>
+      is_link_table <- map(registries, "is_link_table") |>
         unlist()
 
-      standard_lines <- purrr::map_chr(
+      standard_lines <- map_chr(
         names(registries)[!is_link_table],
         function(.registry) {
           paste0("    $", registries[[.registry]]$class_name)
@@ -196,7 +196,7 @@ Instance <- R6::R6Class( # nolint object_name_linter
         lines <- cli::ansi_strip(lines)
       }
 
-      purrr::walk(lines, cli::cat_line)
+      walk(lines, cli::cat_line)
     },
     #' @description
     #' Create a string representation of an `Instance`
@@ -207,7 +207,7 @@ Instance <- R6::R6Class( # nolint object_name_linter
     to_string = function(style = FALSE) {
       registries <- self$get_module("core")$get_registries()
 
-      is_link_table <- purrr::map(registries, "is_link_table") |>
+      is_link_table <- map(registries, "is_link_table") |>
         unlist()
 
       mapping <- list(
@@ -216,7 +216,7 @@ Instance <- R6::R6Class( # nolint object_name_linter
           paste(
             paste0(
               "$",
-              purrr::map_chr(registries[!is_link_table], "class_name")
+              map_chr(registries[!is_link_table], "class_name")
             ),
             collapse = ", "
           ),

diff --git a/R/Module.R b/R/Module.R
@@ -103,10 +103,10 @@ Module <- R6::R6Class( # nolint object_name_linter
     print = function(style = TRUE) {
       registries <- self$get_registries()
 
-      is_link_table <- purrr::map(registries, "is_link_table") |>
+      is_link_table <- map(registries, "is_link_table") |>
         unlist()
 
-      standard_lines <- purrr::map_chr(
+      standard_lines <- map_chr(
         names(registries)[!is_link_table],
         function(.registry) {
           paste0("    $", registries[[.registry]]$class_name)
@@ -123,7 +123,7 @@ Module <- R6::R6Class( # nolint object_name_linter
         lines <- cli::ansi_strip(lines)
       }
 
-      purrr::walk(lines, cli::cat_line)
+      walk(lines, cli::cat_line)
     },
     #' @description
     #' Create a string representation of a `Module`
@@ -134,7 +134,7 @@ Module <- R6::R6Class( # nolint object_name_linter
     to_string = function(style = FALSE) {
       registries <- self$get_registries()
 
-      is_link_table <- purrr::map(registries, "is_link_table") |>
+      is_link_table <- map(registries, "is_link_table") |>
         unlist()
 
       registry_strings <- make_key_value_strings(
@@ -144,7 +144,7 @@ Module <- R6::R6Class( # nolint object_name_linter
             paste(
               paste0(
                 "$",
-                purrr::map_chr(registries[!is_link_table], "class_name")
+                map_chr(registries[!is_link_table], "class_name")
               ),
               collapse = ", "
             ),

diff --git a/R/Registry.R b/R/Registry.R
@@ -76,6 +76,7 @@ Registry <- R6::R6Class( # nolint object_name_linter
     #' @param verbose Boolean, whether to print progress messages
     #'
     #' @return A data.frame containing the available records
+    #' @importFrom purrr reduce modify_depth
     df = function(limit = 100, verbose = FALSE) {
       # The API is limited to 200 records at a time so we need multiple requests
       n_requests <- ceiling(limit / 200)
@@ -88,7 +89,7 @@ Registry <- R6::R6Class( # nolint object_name_linter
 
       data_list <- list()
       attr(data_list, "finished") <- FALSE
-      data_list <- purrr::reduce(
+      data_list <- reduce(
         cli::cli_progress_along(seq_len(n_requests), name = "Sending requests"),
         \(.data_list, .n) {
           # Hacky way of avoiding unneeded requests until there is an easy way
@@ -131,11 +132,11 @@ Registry <- R6::R6Class( # nolint object_name_linter
 
       data_list |>
         # Replace NULL with NA so columns aren't lost
-        purrr::modify_depth(2, \(x) ifelse(is.null(x), NA, x)) |>
+        modify_depth(2, \(x) ifelse(is.null(x), NA, x)) |>
         # Convert each entry to a data.frame
-        purrr::map(as.data.frame) |>
+        map(as.data.frame) |>
         # Bind entries as rows
-        purrr::list_rbind()
+        list_rbind()
     },
     #' @description
     #' Get the fields in the registry.
@@ -176,50 +177,76 @@ Registry <- R6::R6Class( # nolint object_name_linter
     #'
     #' @return A character vector
     print = function(style = TRUE) {
-      fields <- self$get_fields()
-      # Remove hidden fields
-      fields <- fields[grep("^_", names(fields), value = TRUE, invert = TRUE)]
-      # Remove link fields
-      fields <- fields[grep("^links_", names(fields), value = TRUE, invert = TRUE)]
+      # Get fields
+      fields <- self$get_fields() |>
+        # Remove hidden fields
+        discard(~ grepl("^_", .x$field_name)) |>
+        # Remove link fields
+        discard(~ grepl("^links_", .x$field_name))
 
-      relational_fields <- purrr::map(fields, "relation_type") |>
-        unlist() |>
-        names()
+      # Split fields into simple and relational
+      simple_fields <- fields |>
+        keep(~ is.null(.x$relation_type))
+      relational_fields <- fields |>
+        discard(~ is.null(.x$relation_type))
 
-      simple_lines <- purrr::map_chr(
-        setdiff(names(fields), relational_fields),
-        function(.field) {
-          paste0(
-            paste0("    ", .field), ": ",
-            cli::col_grey(fields[[.field]]$type)
+      # Create lines for simple fields
+      simple_lines <-
+        if (length(simple_fields) > 0) {
+          c(
+            cli::style_italic(cli::col_br_magenta("  Simple fields")),
+            map_chr(simple_fields, ~ paste0("    ", .x$field_name, ": ", .x$type))
           )
+        } else {
+          character(0)
         }
-      )
 
-      relational_lines <- purrr::map_chr(relational_fields, function(.field) {
-        field_object <- fields[[.field]]
-        paste0(
-          paste0("    ", .field), ": ",
-          cli::col_grey(paste0(
-            field_object$related_registry_name,
-            " (", field_object$relation_type, ")"
-          ))
+      # Check which modules need to be displayed, make sure "core" is always first
+      relational_field_modules <- map_chr(relational_fields, "related_module_name")
+      related_modules <- unique(relational_field_modules)
+      related_modules <- related_modules[order(related_modules != "core", related_modules)]
+
+      # Create lines for relational fields
+      relational_lines <- map(related_modules, function(related_module_name) {
+        # get heading for module
+        module_heading <-
+          if (related_module_name == "core") {
+            "Relational fields"
+          } else {
+            paste(tools::toTitleCase(related_module_name), "fields")
+          }
+
+        # iterate over fields
+        module_fields <- relational_fields[relational_field_modules == related_module_name]
+        related_module <- private$.instance$get_module(related_module_name)
+        module_lines <- map_chr(module_fields, function(field) {
+          module_prefix <- ifelse(related_module_name == "core", "", paste0(related_module_name, "$"))
+          related_registry <- related_module$get_registry(field$related_registry_name)
+          paste0(
+            "    ", field$field_name, ": ", module_prefix, related_registry$class_name,
+            cli::col_grey(paste0(" (", field$relation_type, ")"))
+          )
+        })
+
+        # return lines
+        c(
+          cli::style_italic(cli::col_br_magenta(paste0("  ", module_heading))),
+          module_lines
         )
-      })
+      }) |>
+        list_c()
 
       lines <- c(
         cli::style_bold(cli::col_br_green(private$.class_name)),
-        cli::style_italic(cli::col_br_magenta("  Simple fields")),
         simple_lines,
-        cli::style_italic(cli::col_br_magenta("  Relational fields")),
         relational_lines
       )
 
       if (isFALSE(style)) {
         lines <- cli::ansi_strip(lines)
       }
 
-      purrr::walk(lines, cli::cat_line)
+      walk(lines, cli::cat_line)
     },
     #' @description
     #' Create a string representation of a `Registry`
@@ -228,32 +255,61 @@ Registry <- R6::R6Class( # nolint object_name_linter
     #'
     #' @return A `cli::cli_ansi_string` if `style = TRUE` or a character vector
     to_string = function(style = FALSE) {
-      fields <- self$get_fields()
-      # Remove hidden fields
-      fields <- fields[grep("^_", names(fields), value = TRUE, invert = TRUE)]
-      # Remove link fields
-      fields <- fields[grep("^links_", names(fields), value = TRUE, invert = TRUE)]
+      # Get fields
+      fields <- self$get_fields() |>
+        # Remove hidden fields
+        discard(~ grepl("^_", .x$field_name)) |>
+        # Remove link fields
+        discard(~ grepl("^links_", .x$field_name))
 
-      relational_fields <- purrr::map(fields, "relation_type") |>
-        unlist() |>
-        names()
+      # Split fields into simple and relational
+      simple_fields <- fields |>
+        keep(~ is.null(.x$relation_type))
+      relational_fields <- fields |>
+        discard(~ is.null(.x$relation_type))
 
-      field_strings <- make_key_value_strings(
+      # Create strings for simple fields
+      simple_strings <- make_key_value_strings(
         list(
           "SimpleFields" = paste0(
             "[",
-            paste(setdiff(names(fields), relational_fields), collapse = ", "),
-            "]"
-          ),
-          "RelationalFields" = paste0(
-            "[",
-            paste(relational_fields, collapse = ", "),
+            paste(map_chr(simple_fields, "field_name"), collapse = ", "),
             "]"
           )
         ),
         quote_strings = FALSE
       )
 
+      # Check which modules need to be displayed, make sure "core" is always first
+      relational_field_modules <- map_chr(relational_fields, "related_module_name")
+      related_modules <- unique(relational_field_modules)
+      related_modules <- related_modules[order(related_modules != "core", related_modules)]
+
+      # Create strings for relational fields
+      relational_strings <- map_chr(related_modules, function(related_module_name) {
+        # get heading for module
+        module_heading <-
+          if (related_module_name == "core") {
+            "RelationalFields"
+          } else {
+            paste0(tools::toTitleCase(related_module_name), "Fields")
+          }
+
+        # iterate over fields
+        module_fields <- relational_fields[relational_field_modules == related_module_name]
+
+        list(
+          paste0("[", paste(map_chr(module_fields, "field_name"), collapse = ", "), "]")
+        ) |>
+          setNames(module_heading) |>
+          make_key_value_strings(quote_strings = FALSE)
+      })
+
+      field_strings <- c(
+        simple_strings,
+        relational_strings
+      )
+
       make_class_string(private$.class_name, field_strings, style = style)
     }
   ),

diff --git a/R/RelatedRecords.R b/R/RelatedRecords.R
@@ -67,6 +67,7 @@ RelatedRecords <- R6::R6Class( # nolint object_name_linter
     .api = NULL,
     .field = NULL,
     .related_to = NULL,
+    #' @importFrom purrr modify_depth list_cbind list_rbind
     get_records = function(as_df = FALSE) {
       field <- private$.field
 
@@ -103,13 +104,13 @@ RelatedRecords <- R6::R6Class( # nolint object_name_linter
 
         values <- related_data |>
           # Replace NULL with NA so columns aren't lost
-          purrr::modify_depth(2, \(x) ifelse(is.null(x), NA, x)) |>
+          modify_depth(2, \(x) ifelse(is.null(x), NA, x)) |>
           # Convert each entry to a data.frame
-          purrr::map(as.data.frame) |>
+          map(as.data.frame) |>
           # Bind entries as rows
-          purrr::list_rbind()
+          list_rbind()
 
-        purrr::map(related_fields, function(.field) {
+        map(related_fields, function(.field) {
           if (.field %in% colnames(values)) {
             return(values[, .field, drop = FALSE])
           } else {
@@ -118,7 +119,7 @@ RelatedRecords <- R6::R6Class( # nolint object_name_linter
             return(column)
           }
         }) |>
-          purrr::list_cbind()
+          list_cbind()
       } else {
         # Get record class for records in the list
         related_module <- private$.instance$get_module(field$related_module_name)

diff --git a/R/laminr-package.R b/R/laminr-package.R
@@ -5,6 +5,6 @@
 #' @importFrom cli cli_abort cli_warn cli_inform
 #' @importFrom R6 R6Class
 #' @importFrom httr GET POST content add_headers
-#' @importFrom purrr map map_chr map2 pmap set_names list_flatten transpose discard keep
+#' @importFrom purrr map map_chr map_lgl map2 pmap set_names list_flatten transpose discard keep list_c walk reduce
 ## usethis namespace: end
 NULL
diff --git a/R/printing.R b/R/printing.R
@@ -16,7 +16,7 @@ make_key_value_strings <- function(mapping, names = NULL, quote_strings = TRUE)
     names <- names(mapping)
   }
 
-  purrr::map_chr(names, function(.name) {
+  map_chr(names, function(.name) {
     value <- mapping[[.name]]
 
     if (is.null(value)) {
@@ -36,7 +36,7 @@ make_key_value_strings <- function(mapping, names = NULL, quote_strings = TRUE)
 
     paste0(.name, "=", value)
   }) |>
-    purrr::discard(is.na)
+    discard(is.na)
 }
 
 #' Make a string representation of a class