Add Profile API to TileDB-R (#856)

* (WIP) Add internal RCpp functions for Profile

* Fix optional string conversion and export typo

* Add Profile R code

* Clean-up return types

Co-authored-by: Paul Hoffman <[email protected]>

* Update Profile Roxygen2 and fix typo

* Fix typo in Rcpp::export

* Add basic profile test

* Add test for using profile in config

* Fix test

* Fix test for windows paths

* Update pkgdown index

* Properly normalize paths in tests

Co-authored-by: Paul Hoffman <[email protected]>

* Normalize expected dir in test as well

* Fix update to pkgdown yaml

Co-authored-by: Paul Hoffman <[email protected]>

* Update roxygen docs

* Fix pkgdown.yml

* Add Profile S4 methods to pkgdown index

* Update version and news

---------

Co-authored-by: Paul Hoffman <[email protected]>

Author: jp-dark

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: tiledb
 Type: Package
-Version: 0.33.1
+Version: 0.33.1.1
 Title: Modern Database Engine for Complex Data Based on Multi-Dimensional Arrays
 Authors@R: c(
   person("TileDB, Inc.", role = c("aut", "cph")),

NAMESPACE

@@ -240,6 +240,14 @@ export(tiledb_object_mv)
 export(tiledb_object_rm)
 export(tiledb_object_type)
 export(tiledb_object_walk)
+export(tiledb_profile)
+export(tiledb_profile_dir)
+export(tiledb_profile_get_param)
+export(tiledb_profile_load)
+export(tiledb_profile_name)
+export(tiledb_profile_remove)
+export(tiledb_profile_save)
+export(tiledb_profile_set_param)
 export(tiledb_put_metadata)
 export(tiledb_query)
 export(tiledb_query_add_range)
@@ -342,6 +350,7 @@ exportClasses(tiledb_filter_list)
 exportClasses(tiledb_fragment_info)
 exportClasses(tiledb_group)
 exportClasses(tiledb_ndrectangle)
+exportClasses(tiledb_profile)
 exportClasses(tiledb_query)
 exportClasses(tiledb_query_condition)
 exportClasses(tiledb_subarray)

NEWS.md

@@ -1,5 +1,9 @@
 # tiledb (development version)
 
+## Improvements
+
+* Add support for creating, loading, saving, and removing Profiles ([#856](https://github.com/TileDB-Inc/TileDB-R/pull/856))
+
 # tiledb 0.33.1
 
 * This release of the R package builds against [TileDB 2.29.1](https://github.com/TileDB-Inc/TileDB/releases/tag/2.29.1), and has also been tested against earlier releases as well as the development version

R/Profile.R

@@ -0,0 +1,124 @@
+#
+# Copyright (c) TileDB Inc. under the MIT License
+#
+
+#' An S4 class for a TileDB Profile object
+#'
+#' @slot ptr An external pointer to the underlying implementation
+#' @exportClass tiledb_profile
+setClass("tiledb_profile",
+  slots = list(ptr = "externalptr")
+)
+
+#' Raw display of a profile object
+#'
+#' This method uses the display method provided by the underlying library.
+#'
+#' @param object A profile object
+#' @export
+setMethod(
+  "raw_dump",
+  signature(object = "tiledb_profile"),
+  definition = function(object) libtiledb_profile_dump(object@ptr)
+)
+
+#' Create a 'tiledb_profile' object
+#'
+#' @param name (optional) Name for the profile
+#' @param dir (optional) Directory to create the profile in
+#' @return A new 'tiledb_profile' object
+#' @export
+tiledb_profile <- function(name = NULL, dir = NULL) {
+  stopifnot(`The 'name' for the profile must be null or a character type` = is.null(name) || is.character(name))
+  stopifnot(`The 'dir' for the profile must be null or a character type` = is.null(name) || is.character(name))
+  ptr <- libtiledb_profile_new(name, dir)
+  profile <- new("tiledb_profile", ptr = ptr)
+  return(profile)
+}
+
+#' Load a saved 'tiledb_profile' object
+#'
+#' @param name (optional) Name of the profile to load
+#' @param dir (optional) Directory where the profile to load is saved
+#' @return The loaded 'tiledb_profile' object
+#' @export
+tiledb_profile_load <- function(name = NULL, dir = NULL) {
+  stopifnot(`The 'name' for the profile must be null or a character type` = is.null(name) || is.character(name))
+  stopifnot(`The 'dir' for the profile must be null or a character type` = is.null(name) || is.character(name))
+  ptr <- libtiledb_profile_load(name, dir)
+  profile <- new("tiledb_profile", ptr = ptr)
+  return(profile)
+}
+
+#' Remove a saved 'tiledb_profile'
+#'
+#' @param name (optional) Name of the profile to remove
+#' @param dir (optional) Directory where the profile to remove is saved
+#' @export
+tiledb_profile_remove <- function(name = NULL, dir = NULL) {
+  stopifnot(`The 'name' for the profile must be null or a character type` = is.null(name) || is.character(name))
+  stopifnot(`The 'dir' for the profile must be null or a character type` = is.null(name) || is.character(name))
+  libtiledb_profile_remove(name, dir)
+  return(invisible(NULL))
+}
+
+#' Get the name of a 'tiledb_profile' object
+#'
+#' @param profile A TileDB profile object
+#' @return The name of the 'tiledb_profile' object
+#' @export
+tiledb_profile_name <- function(profile) {
+  stopifnot(`The 'profile' argument must be a tiledb_profile object` = is(profile, "tiledb_profile"))
+  name <- libtiledb_profile_name(profile@ptr)
+  return(name)
+}
+
+#' Get the directory of a 'tiledb_profile' object
+#'
+#' @param profile A TileDB profile object
+#' @return The directory of the 'tiledb_profile' object
+#' @export
+tiledb_profile_dir <- function(profile) {
+  stopifnot(`The 'profile' argument must be a tiledb_profile object` = is(profile, "tiledb_profile"))
+  dir <- libtiledb_profile_dir(profile@ptr)
+  return(dir)
+}
+
+#' Set a parameter on the 'tiledb_profile' object
+#'
+#' @param profile A TileDB profile object
+#' @param param The key for the new parameter
+#' @param value The value for the new parameter
+#' @export
+tiledb_profile_set_param <- function(profile, param, value) {
+  stopifnot(`The 'profile' argument must be a tiledb_profile object` = is(profile, "tiledb_profile"))
+  stopifnot(`The 'param' arugment must have character type` = is.character(param))
+  stopifnot(`The 'value' arugment must have character type` = is.character(value))
+  libtiledb_profile_set_param(profile@ptr, param, value)
+  return(invisible(NULL))
+}
+
+#' Get the value of a parameter set on the 'tiledb_profile' object
+#'
+#' @param profile A TileDB profile object
+#' @param param The key for the parameter to fetch
+#' @return The value of the requested parameter or NULL if no such parameter exists
+#' @export
+tiledb_profile_get_param <- function(profile, param) {
+  stopifnot(`The 'profile' argument must be a tiledb_profile object` = is(profile, "tiledb_profile"))
+  stopifnot(`The 'param' arugment must have character type` = is.character(param))
+  value <- libtiledb_profile_get_param(profile@ptr, param)
+  return(value)
+}
+
+#' Save the 'tiledb_profile' object
+#'
+#' This will save the 'tiledb_profile' with the name and directory set at creation.
+#'
+#' @param profile The 'tiledb_profile' object to save
+#' @export
+tiledb_profile_save <- function(profile) {
+  stopifnot(`The 'profile' argument must be a tiledb_profile object` = is(profile, "tiledb_profile"))
+  libtiledb_profile_save(profile@ptr)
+  return(invisible(NULL))
+}

R/RcppExports.R

@@ -1233,6 +1233,42 @@ libtiledb_current_domain_is_empty <- function(cd) {
     .Call(`_tiledb_libtiledb_current_domain_is_empty`, cd)
 }
 
+libtiledb_profile_new <- function(name = NULL, dir = NULL) {
+    .Call(`_tiledb_libtiledb_profile_new`, name, dir)
+}
+
+libtiledb_profile_load <- function(name = NULL, dir = NULL) {
+    .Call(`_tiledb_libtiledb_profile_load`, name, dir)
+}
+
+libtiledb_profile_remove <- function(name = NULL, dir = NULL) {
+    invisible(.Call(`_tiledb_libtiledb_profile_remove`, name, dir))
+}
+
+libtiledb_profile_name <- function(profile) {
+    .Call(`_tiledb_libtiledb_profile_name`, profile)
+}
+
+libtiledb_profile_dir <- function(profile) {
+    .Call(`_tiledb_libtiledb_profile_dir`, profile)
+}
+
+libtiledb_profile_set_param <- function(profile, param, value) {
+    invisible(.Call(`_tiledb_libtiledb_profile_set_param`, profile, param, value))
+}
+
+libtiledb_profile_get_param <- function(profile, param) {
+    .Call(`_tiledb_libtiledb_profile_get_param`, profile, param)
+}
+
+libtiledb_profile_save <- function(profile) {
+    invisible(.Call(`_tiledb_libtiledb_profile_save`, profile))
+}
+
+libtiledb_profile_dump <- function(profile) {
+    .Call(`_tiledb_libtiledb_profile_dump`, profile)
+}
+
 vecbuf_to_shmem <- function(dir, name, buf, sz, numvar) {
     invisible(.Call(`_tiledb_vecbuf_to_shmem`, dir, name, buf, sz, numvar))
 }

inst/tinytest/test_config_profile.R

@@ -0,0 +1,36 @@
+library(tinytest)
+library(tiledb)
+
+# Use base directory to prevent over-writing user profiles.
+name <- "test_profile"
+dir <- file.path(tempdir(), "tiledb_config_profile/")
+
+# Create profile
+profile <- tiledb_profile(name, dir)
+
+# Set  some parameters
+token <- "12345"
+server_address <- "https://profile_address.com"
+tiledb_profile_set_param(profile, "rest.token", token)
+tiledb_profile_set_param(profile, "rest.server_address", server_address)
+
+# Save the profile
+tiledb_profile_save(profile)
+
+
+# Create a config and set the profile directory
+config <- tiledb_config(c(profile_name = name, profile_dir = dir))
+config_profile_name <- config["profile_name"]
+config_profile_dir <- config["profile_dir"]
+config_rest_token <- config["rest.token"]
+config_rest_server_address <- config["rest.server_address"]
+
+# Test that the config parameters are set correctly
+expect_equal(config["profile_name"], c(profile_name = name))
+expect_equal(config["profile_dir"], c(profile_dir = dir))
+expect_equal(config["rest.token"], c(rest.token = token))
+expect_equal(config["rest.server_address"], c(rest.server_address = server_address))
+
+
+# Remove the profile
+tiledb_profile_remove(name, dir)

inst/tinytest/test_profile.R

@@ -0,0 +1,100 @@
+library(tinytest)
+library(tiledb)
+
+# Use base directory to prevent over-writing user profiles.
+base_dir <- tempdir()
+dir1 <- file.path(base_dir, "tiledb_profile")
+
+
+# 1. Test creating profiles.
+profile1 <- tiledb_profile()
+profile2 <- tiledb_profile("profile2")
+profile3 <- tiledb_profile(dir=dir1)
+profile4 <- tiledb_profile("profile4", dir1)
+
+expect_equal(tiledb_profile_name(profile1), "default")
+expect_equal(tiledb_profile_name(profile2), "profile2")
+expect_equal(tiledb_profile_name(profile3), "default")
+expect_equal(tiledb_profile_name(profile4), "profile4")
+
+# Skipping checks for default directory since it is platform dependent.
+# Normalize paths on Windows to UNIX-style
+expected_dir <- normalizePath(
+  path = dir1,
+  winslash = "/",
+  mustWork = FALSE
+)
+actual_dir_profile3 <- normalizePath(
+  path = tiledb_profile_dir(profile3),
+  winslash = "/",
+  mustWork = FALSE
+)
+expect_identical(
+  # trim trailing slashes
+  current = sub(pattern = "/+$", replacement = "", x = actual_dir_profile3),
+  target = expected_dir
+)
+actual_dir_profile4 <- normalizePath(
+  path = tiledb_profile_dir(profile4),
+  winslash = "/",
+  mustWork = FALSE
+)
+expect_identical(
+  current = sub(pattern = "/+$", replacement = "", x = actual_dir_profile4),
+  target = expected_dir
+)
+
+
+# 2. Test setting/getting profile parameters.
+key1 <- "username"
+key2 <- "server_address"
+key3 <- "rest.token"
+expected_value1 <- "my_username"
+expected_value2 <- "https://my.address"
+expected_value3 <- "123456"
+
+tiledb_profile_set_param(profile4, key1, expected_value1)
+tiledb_profile_set_param(profile4, key2, expected_value2)
+tiledb_profile_set_param(profile4, key3, expected_value3)
+
+actual_value1 <- tiledb_profile_get_param(profile4, key1)
+actual_value2 <- tiledb_profile_get_param(profile4, key2)
+actual_value3 <- tiledb_profile_get_param(profile4, key3)
+actual_non_value <- tiledb_profile_get_param(profile4, "not_a_parameter")
+
+expect_equal(actual_value1, expected_value1)
+expect_equal(actual_value2, expected_value2)
+expect_equal(actual_value3, expected_value3)
+expect_true(is.null(actual_non_value))
+
+# 3. Test save, load, and remove.
+# IMPORTANT: Do not save a profile to a location that might over-write an actual profile.
+tiledb_profile_save(profile3)
+tiledb_profile_save(profile4)
+
+# -- Check can load profile3
+profile_loaded <- tiledb_profile_load(dir=dir1)
+
+# -- Remove profile2. Check can no longer load.
+tiledb_profile_remove(dir=dir1)
+expect_error(tiledb_profile_load(dir=dir1))
+
+# -- Check loaded profile4
+profile_loaded <- tiledb_profile_load("profile4", dir1)
+expect_equal(tiledb_profile_name(profile_loaded), "profile4")
+expect_equal(tiledb_profile_name(profile_loaded), "profile4")
+loaded_value1 <- tiledb_profile_get_param(profile_loaded, key1)
+loaded_value2 <- tiledb_profile_get_param(profile_loaded, key2)
+loaded_value3 <- tiledb_profile_get_param(profile_loaded, key3)
+loaded_non_value <- tiledb_profile_get_param(profile_loaded, "not_a_parameter")
+expect_equal(loaded_value1, expected_value1)
+expect_equal(loaded_value2, expected_value2)
+expect_equal(loaded_value3, expected_value3)
+expect_true(is.null(loaded_non_value))
+
+# -- Remove profile4
+tiledb_profile_remove("profile4", dir1)
+
+# -- Check cannot load profile2 or profile4.
+expect_error(tiledb_profile_load(dir=dir1))
+expect_error(tiledb_profile_load("profile4", dir1))