data_extract_module.R

#' Check data extract specification
#'
#' @param data_extract_spec (`list`) of `data_extract_spec`.
#'
#' @return Raises an error when check fails, otherwise, it returns the `data_extract_spec`
#' parameter, invisibly and unchanged.
#'
#' @keywords internal
#'
check_data_extract_spec <- function(data_extract_spec) {
  checkmate::assert_list(data_extract_spec, types = "data_extract_spec", null.ok = TRUE)
}

#' Generate id for dataset
#'
#' @param dataname (`character(1)`) the name of the dataset.
#'
#' @return `character(1)`.
#'
#' @keywords internal
#'
id_for_dataset <- function(dataname) {
  paste0("dataset_", dataname, "_singleextract")
}

#' Creates a panel that displays (with filter and column selection)
#' conditionally on `input[ns("dataset")] == dataname`
#'
#' @param ns (`function`) the shiny namespace function.
#' @param single_data_extract_spec (`data_extract_spec`) the specification
#' for extraction of data during the application initialization.
#'
#' Generated by [data_extract_spec()].
#'
#' @return `shiny.tag` with the HTML code for the panel.
#'
#' @keywords internal
#'
cond_data_extract_single_ui <- function(ns, single_data_extract_spec) {
  dataname <- single_data_extract_spec$dataname
  conditionalPanel(
    condition = paste0("input['", ns("dataset"), "'] == '", dataname, "'"),
    data_extract_single_ui(
      id = ns(id_for_dataset(dataname)),
      single_data_extract_spec = single_data_extract_spec
    )
  )
}

#' `teal` data extraction module user-interface
#'
#' @description
#' `r lifecycle::badge("experimental")`
#'
#' @details
#' There are three inputs that will be rendered
#'
#' 1. Dataset select Optional. If more than one [data_extract_spec] is handed over
#' to the function, a shiny [shiny::selectInput] will be rendered. Else just the name
#' of the dataset is given.
#' 2. Filter Panel Optional. If the [data_extract_spec] contains a
#' filter element a shiny [shiny::selectInput] will be rendered with the options to
#' filter the dataset.
#' 3. Select panel A shiny [shiny::selectInput] to select columns from the dataset to
#' go into the analysis.
#'
#' The output can be analyzed using `data_extract_srv(...)`.
#'
#' This functionality should be used in the encoding panel of your `teal` app.
#' It will allow app-developers to specify a [data_extract_spec()] object.
#' This object should be used to `teal` module variables being filtered data
#' from CDISC datasets.
#'
#' You can use this function in the same way as any
#' [`shiny module`](https://shiny.rstudio.com/articles/modules.html) UI.
#' The corresponding server module can be found in [data_extract_srv()].
#'
#' @param id (`character`) shiny input unique identifier.
#' @param label (`character`) Label above the data extract input.
#' @param data_extract_spec (`list` of `data_extract_spec`)
#' This is the outcome of listing [data_extract_spec()] constructor calls.
#' @param is_single_dataset (`logical`) `FALSE` to display the dataset widget.
#'
#' @return Shiny [`shiny::selectInput`]`s` that allow to define how to extract data from
#' a specific dataset. The input elements will be returned inside a [shiny::div] container.
#'
#' @examples
#' library(shiny)
#' library(teal.widgets)
#'
#' adtte_filters <- filter_spec(
#'   vars = c("PARAMCD", "CNSR"),
#'   sep = "-",
#'   choices = c("OS-1" = "OS-1", "OS-0" = "OS-0", "PFS-1" = "PFS-1"),
#'   selected = "OS-1",
#'   multiple = FALSE,
#'   label = "Choose endpoint and Censor"
#' )
#'
#' response_spec <- data_extract_spec(
#'   dataname = "ADTTE",
#'   filter = adtte_filters,
#'   select = select_spec(
#'     choices = c("AVAL", "BMRKR1", "AGE"),
#'     selected = c("AVAL", "BMRKR1"),
#'     multiple = TRUE,
#'     fixed = FALSE,
#'     label = "Column"
#'   )
#' )
#' # Call to use inside your teal module UI function
#' standard_layout(
#'   output = tableOutput("table"),
#'   encoding = tags$div(
#'     data_extract_ui(
#'       id = "regressor",
#'       label = "Regressor Variable",
#'       data_extract_spec = response_spec
#'     )
#'   )
#' )
#' @export
#'
data_extract_ui <- function(id, label, data_extract_spec, is_single_dataset = FALSE) {
  ns <- NS(id)

  if (inherits(data_extract_spec, "data_extract_spec")) {
    data_extract_spec <- list(data_extract_spec)
  }
  check_data_extract_spec(data_extract_spec)

  if (is.null(data_extract_spec)) {
    return(helpText(sprintf("Data extraction with label '%s' is NULL. Please contact the app author.", label)))
  }
  stopifnot(
    `more than one dataset in data_extract_spec but is_single_dataset parameter is set to TRUE` =
      !is_single_dataset || length(data_extract_spec) == 1
  )

  dataset_names <- vapply(
    data_extract_spec,
    function(x) x$dataname,
    character(1),
    USE.NAMES = FALSE
  )

  stopifnot(`list contains data_extract_spec objects with the same dataset` = all(!duplicated(dataset_names)))

  dataset_input <- if (is_single_dataset) {
    NULL
  } else {
    if (length(dataset_names) == 1) {
      if ((is.null(data_extract_spec[[1]]$filter)) &&
        (
          !is.null(data_extract_spec[[1]]$select$fixed) &&
            data_extract_spec[[1]]$select$fixed == TRUE
        )) {
        NULL
      } else {
        helpText("Dataset:", tags$code(dataset_names))
      }
    } else {
      teal.widgets::optionalSelectInput(
        inputId = ns("dataset"),
        label = "Dataset",
        choices = dataset_names,
        selected = dataset_names[1],
        multiple = FALSE
      )
    }
  }
  tagList(
    include_css_files(pattern = "data_extract"),
    tags$div(
      class = "data-extract",
      tags$label(label),
      dataset_input,
      if (length(dataset_names) == 1) {
        data_extract_single_ui(
          id = ns(id_for_dataset(dataset_names)),
          single_data_extract_spec = data_extract_spec[[1]]
        )
      } else {
        do.call(
          div,
          unname(lapply(
            data_extract_spec,
            function(x) {
              cond_data_extract_single_ui(ns, x)
            }
          ))
        )
      }
    )
  )
}

#' Function to check data_extract_specs
#'
#' Checks if `dataname` argument exists as a dataset.
#' Checks if selected or filter columns exist within the datasets. Throws a `shiny`
#' validation error if the above requirements are not met.
#'
#' @param datasets (`FilteredData`) the object created using the `teal` API.
#' @param data_extract (`list`) the output of the `data_extract` module.
#'
#' @return `NULL`.
#'
#' @keywords internal
#'
check_data_extract_spec_react <- function(datasets, data_extract) {
  if (!all(unlist(lapply(data_extract, `[[`, "dataname")) %in% datasets$datanames())) {
    shiny::validate(
      "Error in data_extract_spec setup:\
        Data extract spec contains datasets that were not handed over to the teal app."
    )
  }

  column_return <- unlist(lapply(
    data_extract,
    function(data_extract_spec) {
      columns_filter <- if (is.null(data_extract_spec$filter)) {
        NULL
      } else {
        unique(unlist(lapply(
          data_extract_spec$filter,
          function(x) {
            if (inherits(x, "filter_spec")) {
              x$vars_choices
            } else {
              stop("Unsupported object class")
            }
          }
        )))
      }

      columns_ds <- unique(c(
        data_extract_spec$select$choices,
        columns_filter
      ))

      if (!all(columns_ds %in% names(datasets$get_data(data_extract_spec$dataname, filtered = FALSE)))) {
        non_columns <- columns_ds[!columns_ds %in% names(
          datasets$get_data(data_extract_spec$dataname, filtered = FALSE)
        )]
        paste0(
          "Error in data_extract_spec setup: ",
          "Column '",
          non_columns,
          "' is not inside dataset '",
          data_extract_spec$dataname, "'."
        )
      }
    }
  ))

  if (!is.null(column_return)) shiny::validate(unlist(column_return))
  NULL
}

#' Extraction of the selector(s) details
#'
#' @description
#' `r lifecycle::badge("stable")`
#'
#' Extracting details of the selection(s) in [data_extract_ui] elements.
#'
#' @inheritParams shiny::moduleServer
#' @param datasets (`FilteredData` or `list` of `reactive` or non-`reactive` `data.frame`)
#' object containing data either in the form of `FilteredData` or as a list of `data.frame`.
#' When passing a list of non-reactive `data.frame` objects, they are converted to reactive `data.frame`s internally.
#' When passing a list of reactive or non-reactive `data.frame` objects, the argument `join_keys` is required also.
#' @param data_extract_spec (`data_extract_spec` or a list of `data_extract_spec`)
#' A list of data filter and select information constructed by [data_extract_spec].
#' @param ... An additional argument `join_keys` is required when `datasets` is a list of `data.frame`.
#' It shall contain the keys per dataset in `datasets`.
#'
#' @return A reactive `list` containing following fields:
#'
#' * `filters`: A list with the information on the filters that are applied to the data set.
#' * `select`: The variables that are selected from the dataset.
#' * `always_selected`: The column names from the data set that should always be selected.
#' * `reshape`: Whether reshape long to wide should be applied or not.
#' * `dataname`: The name of the data set.
#' * `internal_id`: The `id` of the corresponding shiny input element.
#' * `keys`: The names of the columns that can be used to merge the data set.
#' * `iv`: A `shinyvalidate::InputValidator` containing `validator` for this `data_extract`.
#'
#' @references [data_extract_srv]
#'
#' @examples
#' library(shiny)
#' library(shinyvalidate)
#' library(teal.data)
#' library(teal.widgets)
#'
#' # Sample ADSL dataset
#' ADSL <- data.frame(
#'   STUDYID = "A",
#'   USUBJID = LETTERS[1:10],
#'   SEX = rep(c("F", "M"), 5),
#'   AGE = rpois(10, 30),
#'   BMRKR1 = rlnorm(10)
#' )
#'
#' # Specification for data extraction
#' adsl_extract <- data_extract_spec(
#'   dataname = "ADSL",
#'   filter = filter_spec(vars = "SEX", choices = c("F", "M"), selected = "F"),
#'   select = select_spec(
#'     label = "Select variable:",
#'     choices = variable_choices(ADSL, c("AGE", "BMRKR1")),
#'     selected = "AGE",
#'     multiple = TRUE,
#'     fixed = FALSE
#'   )
#' )
#'
#' # Using reactive list of data.frames
#' data_list <- list(ADSL = reactive(ADSL))
#'
#' join_keys <- join_keys(join_key("ADSL", "ADSL", c("STUDYID", "USUBJID")))
#'
#' # App: data extraction with validation
#' ui <- fluidPage(
#'   standard_layout(
#'     output = verbatimTextOutput("out1"),
#'     encoding = tagList(
#'       data_extract_ui(
#'         id = "adsl_var",
#'         label = "ADSL selection",
#'         data_extract_spec = adsl_extract
#'       )
#'     )
#'   )
#' )
#' server <- function(input, output, session) {
#'   adsl_reactive_input <- data_extract_srv(
#'     id = "adsl_var",
#'     datasets = data_list,
#'     data_extract_spec = adsl_extract,
#'     join_keys = join_keys,
#'     select_validation_rule = sv_required("Please select a variable.")
#'   )
#'
#'   iv_r <- reactive({
#'     iv <- InputValidator$new()
#'     iv$add_validator(adsl_reactive_input()$iv)
#'     iv$enable()
#'     iv
#'   })
#'
#'   output$out1 <- renderPrint({
#'     if (iv_r()$is_valid()) {
#'       cat(format_data_extract(adsl_reactive_input()))
#'     } else {
#'       "Please fix errors in your selection"
#'     }
#'   })
#' }
#'
#' if (interactive()) {
#'   shinyApp(ui, server)
#' }
#'
#' # App: simplified data extraction
#' ui <- fluidPage(
#'   standard_layout(
#'     output = verbatimTextOutput("out1"),
#'     encoding = tagList(
#'       data_extract_ui(
#'         id = "adsl_var",
#'         label = "ADSL selection",
#'         data_extract_spec = adsl_extract
#'       )
#'     )
#'   )
#' )
#'
#' server <- function(input, output, session) {
#'   adsl_reactive_input <- data_extract_srv(
#'     id = "adsl_var",
#'     datasets = data_list,
#'     data_extract_spec = adsl_extract
#'   )
#'
#'   output$out1 <- renderPrint(adsl_reactive_input())
#' }
#'
#' if (interactive()) {
#'   shinyApp(ui, server)
#' }
#' @export
#'
data_extract_srv <- function(id, datasets, data_extract_spec, ...) {
  checkmate::assert_multi_class(datasets, c("FilteredData", "list"))
  checkmate::assert(
    checkmate::check_class(data_extract_spec, "data_extract_spec"),
    checkmate::check_list(data_extract_spec, "data_extract_spec")
  )
  UseMethod("data_extract_srv", datasets)
}

#' @rdname data_extract_srv
#' @export
#'
data_extract_srv.FilteredData <- function(id, datasets, data_extract_spec, ...) {
  checkmate::assert_class(datasets, "FilteredData")
  moduleServer(
    id,
    function(input, output, session) {
      logger::log_trace(
        "data_extract_srv.FilteredData initialized with datasets: { paste(datasets$datanames(), collapse = ', ') }."
      )

      data_list <- sapply(X = datasets$datanames(), simplify = FALSE, FUN = function(x) {
        reactive(datasets$get_data(dataname = x, filtered = TRUE))
      })

      join_keys <- datasets$get_join_keys()

      filter_and_select_reactive <- data_extract_srv(
        id = NULL,
        datasets = data_list,
        data_extract_spec = data_extract_spec,
        join_keys = join_keys
      )
      filter_and_select_reactive
    }
  )
}

#' @rdname data_extract_srv
#'
#' @param join_keys (`join_keys` or `NULL`) of keys per dataset in `datasets`.
#' @param select_validation_rule (`NULL` or `function`)
#' Should there be any `shinyvalidate` input validation of the select parts of the `data_extract_ui`.
#'
#' You can use a validation function directly (i.e. `select_validation_rule = shinyvalidate::sv_required()`)
#' or for more fine-grained control use a function:
#'
#' `select_validation_rule = ~ if (length(.) > 2) "Error"`.
#'
#' If `NULL` then no validation will be added. See example for more details.
#' @param filter_validation_rule (`NULL` or `function`) Same as
#' `select_validation_rule` but for the filter (values) part of the `data_extract_ui`.
#' @param dataset_validation_rule (`NULL` or `function`) Same as
#' `select_validation_rule` but for the choose dataset part of the `data_extract_ui`
#' @export
#'
data_extract_srv.list <- function(id,
                                  datasets,
                                  data_extract_spec,
                                  join_keys = NULL,
                                  select_validation_rule = NULL,
                                  filter_validation_rule = NULL,
                                  dataset_validation_rule = if (
                                    is.null(select_validation_rule) &&
                                      is.null(filter_validation_rule)
                                  ) {
                                    NULL
                                  } else {
                                    shinyvalidate::sv_required("Please select a dataset")
                                  },
                                  ...) {
  checkmate::assert_list(datasets, types = c("reactive", "data.frame"), names = "named")
  checkmate::assert_class(join_keys, "join_keys", null.ok = TRUE)
  checkmate::assert_multi_class(select_validation_rule, classes = c("function", "formula"), null.ok = TRUE)
  checkmate::assert_multi_class(filter_validation_rule, classes = c("function", "formula"), null.ok = TRUE)
  checkmate::assert_multi_class(dataset_validation_rule, classes = c("function", "formula"), null.ok = TRUE)

  moduleServer(
    id,
    function(input, output, session) {
      logger::log_trace(
        "data_extract_srv.list initialized with datasets: { paste(names(datasets), collapse = ', ') }."
      )

      # get keys out of join_keys
      if (length(join_keys)) {
        keys <- sapply(names(datasets), simplify = FALSE, function(x) join_keys[x, x])
      } else {
        keys <- sapply(names(datasets), simplify = FALSE, function(x) character(0))
      }

      # convert to list of reactives
      datasets <- sapply(X = datasets, simplify = FALSE, FUN = function(x) {
        if (is.reactive(x)) x else reactive(x)
      })

      if (inherits(data_extract_spec, "data_extract_spec")) {
        data_extract_spec <- list(data_extract_spec)
      }

      for (idx in seq_along(data_extract_spec)) {
        if (inherits(data_extract_spec[[idx]]$filter, "filter_spec")) {
          data_extract_spec[[idx]]$filter <- list(data_extract_spec[[idx]]$filter)
        }
      }

      if (is.null(data_extract_spec)) {
        return(reactive(NULL))
      }
      check_data_extract_spec(data_extract_spec = data_extract_spec)

      # Each dataset needs its own shinyvalidate to make sure only the
      # currently visible d-e-s's validation is used
      iv <- lapply(data_extract_spec, function(x) {
        iv_dataset <- shinyvalidate::InputValidator$new()
        if (!is.null(dataset_validation_rule) && length(data_extract_spec) > 1) {
          iv_dataset$add_rule("dataset", dataset_validation_rule)
        }
        iv_dataset
      })
      names(iv) <- lapply(data_extract_spec, `[[`, "dataname")

      # also need a final iv for the case where no dataset is selected
      iv[["blank_dataset_case"]] <- shinyvalidate::InputValidator$new()
      if (!is.null(dataset_validation_rule) && length(data_extract_spec) > 1) {
        iv[["blank_dataset_case"]]$add_rule("dataset", dataset_validation_rule)
      }

      filter_and_select <- lapply(data_extract_spec, function(x) {
        data_extract_single_srv(
          id = id_for_dataset(x$dataname),
          datasets = datasets,
          single_data_extract_spec = x
        )

        data_extract_read_srv(
          id = id_for_dataset(x$dataname),
          datasets = datasets,
          single_data_extract_spec = x,
          iv = iv[[x$dataname]],
          select_validation_rule = select_validation_rule,
          filter_validation_rule = filter_validation_rule
        )
      })
      names(filter_and_select) <- sapply(data_extract_spec, function(x) x$dataname)

      dataname <- reactive({
        # For fixed data sets, ignore input_value
        if (is.null(input$dataset) && length(data_extract_spec) < 2) {
          data_extract_spec[[1]]$dataname
          # For data set selectors, return NULL if NULL
        } else {
          input$dataset
        }
      })

      filter_and_select_reactive <- reactive({
        if (is.null(dataname())) {
          list(iv = iv[["blank_dataset_case"]])
        } else {
          append(
            filter_and_select[[dataname()]](),
            list(
              dataname = dataname(),
              internal_id = gsub("^.*-(.+)$", "\\1", session$ns(NULL)), # parent module id
              keys = keys[[dataname()]]
            )
          )
        }
      })
      filter_and_select_reactive
    }
  )
}

#' Creates a named list of `data_extract_srv` output
#'
#' @description
#' `r lifecycle::badge("experimental")`
#'
#' `data_extract_multiple_srv` loops over the list of `data_extract` given and
#' runs `data_extract_srv` for each one returning a list of reactive objects.
#'
#' @inheritParams data_extract_srv
#' @param data_extract (named `list` of `data_extract_spec` objects) the list `data_extract_spec` objects.
#' The names of the elements in the list need to correspond to the `ids` passed to `data_extract_ui`.
#'
#' See example for details.
#'
#' @return reactive named `list` containing outputs from [data_extract_srv()].
#' Output list names are the same as `data_extract` input argument.
#'
#' @examples
#' library(shiny)
#' library(shinyvalidate)
#' library(shinyjs)
#' library(teal.widgets)
#'
#' iris_select <- data_extract_spec(
#'   dataname = "iris",
#'   select = select_spec(
#'     label = "Select variable:",
#'     choices = variable_choices(iris, colnames(iris)),
#'     selected = "Sepal.Length",
#'     multiple = TRUE,
#'     fixed = FALSE
#'   )
#' )
#'
#' iris_filter <- data_extract_spec(
#'   dataname = "iris",
#'   filter = filter_spec(
#'     vars = "Species",
#'     choices = c("setosa", "versicolor", "virginica"),
#'     selected = "setosa",
#'     multiple = TRUE
#'   )
#' )
#'
#' data_list <- list(iris = reactive(iris))
#'
#' ui <- fluidPage(
#'   useShinyjs(),
#'   standard_layout(
#'     output = verbatimTextOutput("out1"),
#'     encoding = tagList(
#'       data_extract_ui(
#'         id = "x_var",
#'         label = "Please select an X column",
#'         data_extract_spec = iris_select
#'       ),
#'       data_extract_ui(
#'         id = "species_var",
#'         label = "Please select 2 Species",
#'         data_extract_spec = iris_filter
#'       )
#'     )
#'   )
#' )
#'
#' server <- function(input, output, session) {
#'   selector_list <- data_extract_multiple_srv(
#'     list(x_var = iris_select, species_var = iris_filter),
#'     datasets = data_list,
#'     select_validation_rule = list(
#'       x_var = sv_required("Please select an X column")
#'     ),
#'     filter_validation_rule = list(
#'       species_var = compose_rules(
#'         sv_required("Exactly 2 Species must be chosen"),
#'         function(x) if (length(x) != 2) "Exactly 2 Species must be chosen"
#'       )
#'     )
#'   )
#'   iv_r <- reactive({
#'     iv <- InputValidator$new()
#'     compose_and_enable_validators(
#'       iv,
#'       selector_list,
#'       validator_names = NULL
#'     )
#'   })
#'
#'   output$out1 <- renderPrint({
#'     if (iv_r()$is_valid()) {
#'       ans <- lapply(selector_list(), function(x) {
#'         cat(format_data_extract(x()), "\n\n")
#'       })
#'     } else {
#'       "Please fix errors in your selection"
#'     }
#'   })
#' }
#'
#' if (interactive()) {
#'   shinyApp(ui, server)
#' }
#' @export
#'
data_extract_multiple_srv <- function(data_extract, datasets, ...) {
  checkmate::assert_list(data_extract, names = "named")
  checkmate::assert_multi_class(datasets, c("reactive", "FilteredData", "list"))
  lapply(data_extract, function(x) {
    if (is.list(x) && !inherits(x, "data_extract_spec")) {
      checkmate::assert_list(x, "data_extract_spec")
    }
  })
  UseMethod("data_extract_multiple_srv", datasets)
}

#' @rdname data_extract_multiple_srv
#' @export
#'
data_extract_multiple_srv.reactive <- function(data_extract, datasets, ...) {
  # convert reactive containing teal_data to list of reactives with one dataset each
  datasets_new <- convert_teal_data(datasets)
  data_extract_multiple_srv.list(data_extract, datasets_new, ...)
}

#' @rdname data_extract_multiple_srv
#' @export
#'
data_extract_multiple_srv.FilteredData <- function(data_extract, datasets, ...) {
  checkmate::assert_class(datasets, classes = "FilteredData")
  logger::log_trace(
    "data_extract_multiple_srv.filteredData initialized with dataset: { paste(datasets$datanames(), collapse = ', ') }."
  )

  data_list <- sapply(X = datasets$datanames(), simplify = FALSE, FUN = function(x) {
    reactive(datasets$get_data(dataname = x, filtered = TRUE))
  })

  join_keys <- datasets$get_join_keys()
  data_extract_multiple_srv(data_extract = data_extract, datasets = data_list, join_keys = join_keys)
}

#' @rdname data_extract_multiple_srv
#'
#' @param join_keys (`join_keys` or `NULL`) of join keys per dataset in `datasets`.
#' @param select_validation_rule (`NULL` or `function` or `named list` of `function`)
#' Should there be any `shinyvalidate` input validation of the select parts of the `data_extract_ui`.
#' If all `data_extract` require the same validation function then this can be used directly
#' (i.e. `select_validation_rule = shinyvalidate::sv_required()`).
#'
#' For more fine-grained control use a list:
#'
#' `select_validation_rule = list(extract_1 = sv_required(), extract2 = ~ if (length(.) > 2) "Error")`
#'
#' If `NULL` then no validation will be added.
#'
#' See example for more details.
#' @param filter_validation_rule (`NULL` or `function` or `named list` of `function`) Same as
#' `select_validation_rule` but for the filter (values) part of the `data_extract_ui`.
#' @param dataset_validation_rule (`NULL` or `function` or `named list` of `function`) Same as
#' `select_validation_rule` but for the choose dataset part of the `data_extract_ui`
#'
#' @export
#'
data_extract_multiple_srv.list <- function(data_extract,
                                           datasets,
                                           join_keys = NULL,
                                           select_validation_rule = NULL,
                                           filter_validation_rule = NULL,
                                           dataset_validation_rule = if (
                                             is.null(select_validation_rule) &&
                                               is.null(filter_validation_rule)
                                           ) {
                                             NULL
                                           } else {
                                             shinyvalidate::sv_required("Please select a dataset")
                                           },
                                           ...) {
  checkmate::assert_list(datasets, types = c("reactive", "data.frame"), names = "named")
  checkmate::assert_class(join_keys, "join_keys", null.ok = TRUE)
  checkmate::assert(
    checkmate::check_multi_class(select_validation_rule, classes = c("function", "formula"), null.ok = TRUE),
    checkmate::check_list(select_validation_rule, types = c("function", "formula", "NULL"), null.ok = TRUE)
  )
  checkmate::assert(
    checkmate::check_multi_class(filter_validation_rule, classes = c("function", "formula"), null.ok = TRUE),
    checkmate::check_list(filter_validation_rule, types = c("function", "formula", "NULL"), null.ok = TRUE)
  )
  checkmate::assert(
    checkmate::check_multi_class(dataset_validation_rule, classes = c("function", "formula"), null.ok = TRUE),
    checkmate::check_list(dataset_validation_rule, types = c("function", "formula", "NULL"), null.ok = TRUE)
  )

  logger::log_trace(
    "data_extract_multiple_srv.list initialized with dataset: { paste(names(datasets), collapse = ', ') }."
  )

  data_extract <- Filter(Negate(is.null), data_extract)

  if (is.function(select_validation_rule)) {
    select_validation_rule <- sapply(
      names(data_extract),
      simplify = FALSE,
      USE.NAMES = TRUE,
      function(x) select_validation_rule
    )
  }

  if (is.function(dataset_validation_rule)) {
    dataset_validation_rule <- sapply(
      names(data_extract),
      simplify = FALSE,
      USE.NAMES = TRUE,
      function(x) dataset_validation_rule
    )
  }

  reactive({
    sapply(
      X = names(data_extract),
      simplify = FALSE,
      USE.NAMES = TRUE,
      function(x) {
        data_extract_srv(
          id = x,
          data_extract_spec = data_extract[[x]],
          datasets = datasets,
          join_keys = join_keys,
          select_validation_rule = select_validation_rule[[x]],
          filter_validation_rule = filter_validation_rule[[x]],
          dataset_validation_rule = dataset_validation_rule[[x]]
        )
      }
    )
  })
}