From 84c1f896879ddcf82d2fb23a2896430147754763 Mon Sep 17 00:00:00 2001 From: Luke Zappia Date: Fri, 1 Nov 2024 15:19:10 +0100 Subject: [PATCH] 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 --- CHANGELOG.md | 2 + NAMESPACE | 7 ++ R/Artifact.R | 4 +- R/Instance.R | 10 +-- R/Module.R | 10 +-- R/Registry.R | 148 +++++++++++++++++++++++---------- R/RelatedRecords.R | 11 +-- R/laminr-package.R | 2 +- R/printing.R | 4 +- R/utils.R | 2 +- tests/testthat/test-Registry.R | 42 ++++++++++ 11 files changed, 175 insertions(+), 67 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index 14f2736..8016115 100644 --- 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 index b4e087b..02250bf 100644 --- 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 index ead5d1d..0f0cb16 100644 --- 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 index 2903096..f015da5 100644 --- 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 index 7edbe7c..08ab119 100644 --- 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 index 6db1c2b..be0c1b8 100644 --- 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,42 +177,68 @@ 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 ) @@ -219,7 +246,7 @@ Registry <- 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 `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 index 0bb96d9..9c338e1 100644 --- 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 index 85e054e..2b04b2d 100644 --- 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 index 51d3018..094ebfa 100644 --- 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 diff --git a/R/utils.R b/R/utils.R index 31fd711..c99b9b7 100644 --- a/R/utils.R +++ b/R/utils.R @@ -11,7 +11,7 @@ #' [cli::cli_abort()] #' @noRd check_requires <- function(what, requires) { - is_available <- purrr::map_lgl(requires, requireNamespace, quietly = TRUE) + is_available <- map_lgl(requires, requireNamespace, quietly = TRUE) if (any(!is_available)) { missing <- requires[!is_available] diff --git a/tests/testthat/test-Registry.R b/tests/testthat/test-Registry.R index c6b2402..e86140b 100644 --- a/tests/testthat/test-Registry.R +++ b/tests/testthat/test-Registry.R @@ -10,3 +10,45 @@ test_that("df works", { expect_s3_class(records, "data.frame") expect_true(all(c("description", "created_at", "id", "uid") %in% colnames(records))) }) + +test_that("to_string works", { + local_setup_lamindata_instance() + + db <- connect("laminlabs/lamindata") + + str <- db$bionty$Phenotype$to_string() + + expect_type(str, "character") + + regex <- paste0( + "Phenotype\\(", + "SimpleFields=\\[id, uid,[^\\]*\\], ", + "RelationalFields=\\[[^\\]*\\], ", + "BiontyFields=\\[[^\\]*\\]", + "\\)" + ) + + expect_match(str, regex) +}) + +test_that("print works", { + local_setup_lamindata_instance() + + db <- connect("laminlabs/lamindata") + + regex <- paste0( + "Phenotype\n", + " Simple fields\n", + " id: AutoField\n", + " uid: CharField\n", + ".*", + " Relational fields\n", + " run: Run \\(many-to-one\\)\n", + ".*", + " Bionty fields\n", + " source: bionty\\$Source \\(many-to-one\\)\n", + ".*" + ) + + expect_output(db$bionty$Phenotype$print(style = FALSE), regex) +})