R/configurable.R

In tjpalanca/webtools: Web Server Tools

#' @title Configurable
#'
#' @description
#' This base class contains utilities for objects to manage their own
#' configuration (public) and metadata (private).
#'
Configurable <- R6Class(
  classname = "Configurable",
  public = list(

    #' @description config set configuration
    #' @param name  (str) human readable name
    #' @param .list (lst) pass config or metadata as a list
    #' @param ...   (kvp) key value pairs of configuration
    set_config = function(name, ..., .list = NULL) {

      assert_string(name)
      value <- assert_list(.list %||% list(...), names = "named")
      private$.config[[name]] <-
        modifyList(private$.config[[name]] %||% list(), value)

    }

  ),

  active = list(

    #' @field metadata metadata set
    metadata = function() private$.metadata,

    #' @field config configuration set
    config = function() private$.config

  ),

  private = list(

    # Private configuration
    .config = list(),

    # Metadata
    .metadata = list(),

    # Setting metadata
    set_metadata = function(name, ..., .list = NULL) {

      assert_string(name)
      value <- assert_list(.list %||% list(...), names = "named")
      private$.metadata[[name]] <-
        modifyList(private$.metadata[[name]] %||% list(), value)

    },

    # Utility to find an element using keep and discard formula
    find_element = function(metadata, ..., discard = FALSE) {

      if (is.null(metadata)) return(character(0))
      assert_flag(discard)
      assert_list(metadata, names = "named")
      selectors <- assert_list(enquos(...))
      selectfun <- if (discard) purrr::discard else keep

      metadata %>%
        keep(~length(.) > 0) %>%
        selectfun(
          ~every(
            selectors,
            function(selector, metadata) {
              isTRUE(possibly(eval_tidy, FALSE)(selector, data = metadata))
            },
            metadata = .
          )
        ) %>%
        names()

    }

  )
)