-
- 1 |
- |
-
- #' Creates a `teal_modules` object.
- |
-
-
- 2 |
- |
-
- #'
- |
-
-
- 3 |
- |
-
- #' @description `r lifecycle::badge("stable")`
- |
-
-
- 4 |
- |
-
- #' This function collects a list of `teal_modules` and `teal_module` objects and returns a `teal_modules` object
- |
-
-
- 5 |
- |
-
- #' containing the passed objects.
- |
-
-
- 6 |
- |
-
- #'
- |
-
-
- 7 |
- |
-
- #' This function dictates what modules are included in a `teal` application. The internal structure of `teal_modules`
- |
-
-
- 8 |
- |
-
- #' shapes the navigation panel of a `teal` application.
- |
-
-
- 9 |
- |
-
- #'
- |
-
-
- 10 |
- |
-
- #' @param ... (`teal_module` or `teal_modules`) see [module()] and [modules()] for more details
- |
-
-
- 11 |
- |
-
- #' @param label (`character(1)`) label of modules collection (default `"root"`).
- |
-
-
- 12 |
- |
-
- #' If using the `label` argument then it must be explicitly named.
- |
-
-
- 13 |
- |
-
- #' For example `modules("lab", ...)` should be converted to `modules(label = "lab", ...)`
- |
-
-
- 14 |
- |
-
- #'
- |
-
-
- 15 |
- |
-
- #' @export
- |
-
-
- 16 |
- |
-
- #'
- |
-
-
- 17 |
- |
-
- #' @return object of class \code{teal_modules}. Object contains following fields
- |
-
-
- 18 |
- |
-
- #' - `label`: taken from the `label` argument
- |
-
-
- 19 |
- |
-
- #' - `children`: a list containing objects passed in `...`. List elements are named after
- |
-
-
- 20 |
- |
-
- #' their `label` attribute converted to a valid `shiny` id.
- |
-
-
- 21 |
- |
-
- #' @examples
- |
-
-
- 22 |
- |
-
- #' library(shiny)
- |
-
-
- 23 |
- |
-
- #'
- |
-
-
- 24 |
- |
-
- #' app <- init(
- |
-
-
- 25 |
- |
-
- #' data = teal_data(dataset("iris", iris)),
- |
-
-
- 26 |
- |
-
- #' modules = modules(
- |
-
-
- 27 |
- |
-
- #' label = "Modules",
- |
-
-
- 28 |
- |
-
- #' modules(
- |
-
-
- 29 |
- |
-
- #' label = "Module",
- |
-
-
- 30 |
- |
-
- #' module(
- |
-
-
- 31 |
- |
-
- #' label = "Inner module",
- |
-
-
- 32 |
- |
-
- #' server = function(id, data) {
- |
-
-
- 33 |
- |
-
- #' moduleServer(
- |
-
-
- 34 |
- |
-
- #' id,
- |
-
-
- 35 |
- |
-
- #' module = function(input, output, session) {
- |
-
-
- 36 |
- |
-
- #' output$data <- renderDataTable(data[["iris"]]())
- |
-
-
- 37 |
- |
-
- #' }
- |
-
-
- 38 |
- |
-
- #' )
- |
-
-
- 39 |
- |
-
- #' },
- |
-
-
- 40 |
- |
-
- #' ui = function(id) {
- |
-
-
- 41 |
- |
-
- #' ns <- NS(id)
- |
-
-
- 42 |
- |
-
- #' tagList(dataTableOutput(ns("data")))
- |
-
-
- 43 |
- |
-
- #' },
- |
-
-
- 44 |
- |
-
- #' datanames = "all"
- |
-
-
- 45 |
- |
-
- #' )
- |
-
-
- 46 |
- |
-
- #' ),
- |
-
-
- 47 |
- |
-
- #' module(
- |
-
-
- 48 |
- |
-
- #' label = "Another module",
- |
-
-
- 49 |
- |
-
- #' server = function(id) {
- |
-
-
- 50 |
- |
-
- #' moduleServer(
- |
-
-
- 51 |
- |
-
- #' id,
- |
-
-
- 52 |
- |
-
- #' module = function(input, output, session) {
- |
-
-
- 53 |
- |
-
- #' output$text <- renderText("Another module")
- |
-
-
- 54 |
- |
-
- #' }
- |
-
-
- 55 |
- |
-
- #' )
- |
-
-
- 56 |
- |
-
- #' },
- |
-
-
- 57 |
- |
-
- #' ui = function(id) {
- |
-
-
- 58 |
- |
-
- #' ns <- NS(id)
- |
-
-
- 59 |
- |
-
- #' tagList(textOutput(ns("text")))
- |
-
-
- 60 |
- |
-
- #' },
- |
-
-
- 61 |
- |
-
- #' datanames = NULL
- |
-
-
- 62 |
- |
-
- #' )
- |
-
-
- 63 |
- |
-
- #' )
- |
-
-
- 64 |
- |
-
- #' )
- |
-
-
- 65 |
- |
-
- #' if (interactive()) {
- |
-
-
- 66 |
- |
-
- #' runApp(app)
- |
-
-
- 67 |
- |
-
- #' }
- |
-
-
- 68 |
- |
-
- modules <- function(..., label = "root") {
- |
-
-
- 69 |
- 79x |
-
- checkmate::assert_string(label)
- |
-
-
- 70 |
- 77x |
-
- submodules <- list(...)
- |
-
-
- 71 |
- 77x |
-
- if (any(vapply(submodules, is.character, FUN.VALUE = logical(1)))) {
- |
-
-
- 72 |
- 2x |
-
- stop(
- |
-
-
- 73 |
- 2x |
-
- "The only character argument to modules() must be 'label' and it must be named, ",
- |
-
-
- 74 |
- 2x |
-
- "change modules('lab', ...) to modules(label = 'lab', ...)"
- |
-
-
- 75 |
- |
-
- )
- |
-
-
- 76 |
- |
-
- }
- |
-
-
- 77 |
- |
-
-
- |
-
-
- 78 |
- 75x |
-
- checkmate::assert_list(submodules, min.len = 1, any.missing = FALSE, types = c("teal_module", "teal_modules"))
- |
-
-
- 79 |
- |
-
- # name them so we can more easily access the children
- |
-
-
- 80 |
- |
-
- # beware however that the label of the submodules should not be changed as it must be kept synced
- |
-
-
- 81 |
- 72x |
-
- labels <- vapply(submodules, function(submodule) submodule$label, character(1))
- |
-
-
- 82 |
- 72x |
-
- names(submodules) <- make.unique(gsub("[^[:alnum:]]+", "_", labels), sep = "_")
- |
-
-
- 83 |
- 72x |
-
- structure(
- |
-
-
- 84 |
- 72x |
-
- list(
- |
-
-
- 85 |
- 72x |
-
- label = label,
- |
-
-
- 86 |
- 72x |
-
- children = submodules
- |
-
-
- 87 |
- |
-
- ),
- |
-
-
- 88 |
- 72x |
-
- class = "teal_modules"
- |
-
-
- 89 |
- |
-
- )
- |
-
-
- 90 |
- |
-
- }
- |
-
-
- 91 |
- |
-
-
- |
-
-
- 92 |
- |
-
- #' Function which appends a teal_module onto the children of a teal_modules object
- |
-
-
- 93 |
- |
-
- #' @keywords internal
- |
-
-
- 94 |
- |
-
- #' @param modules `teal_modules`
- |
-
-
- 95 |
- |
-
- #' @param module `teal_module` object to be appended onto the children of `modules`
- |
-
-
- 96 |
- |
-
- #' @return `teal_modules` object with `module` appended
- |
-
-
- 97 |
- |
-
- append_module <- function(modules, module) {
- |
-
-
- 98 |
- 7x |
-
- checkmate::assert_class(modules, "teal_modules")
- |
-
-
- 99 |
- 5x |
-
- checkmate::assert_class(module, "teal_module")
- |
-
-
- 100 |
- 3x |
-
- modules$children <- c(modules$children, list(module))
- |
-
-
- 101 |
- 3x |
-
- labels <- vapply(modules$children, function(submodule) submodule$label, character(1))
- |
-
-
- 102 |
- 3x |
-
- names(modules$children) <- make.unique(gsub("[^[:alnum:]]", "_", tolower(labels)), sep = "_")
- |
-
-
- 103 |
- 3x |
-
- modules
- |
-
-
- 104 |
- |
-
- }
- |
-
-
- 105 |
- |
-
-
- |
-
-
- 106 |
- |
-
- #' Does the object make use of the `arg`
- |
-
-
- 107 |
- |
-
- #'
- |
-
-
- 108 |
- |
-
- #' @param modules (`teal_module` or `teal_modules`) object
- |
-
-
- 109 |
- |
-
- #' @param arg (`character(1)`) names of the arguments to be checked against formals of `teal` modules.
- |
-
-
- 110 |
- |
-
- #' @return `logical` whether the object makes use of `arg`
- |
-
-
- 111 |
- |
-
- #' @rdname is_arg_used
- |
-
-
- 112 |
- |
-
- #' @keywords internal
- |
-
-
- 113 |
- |
-
- is_arg_used <- function(modules, arg) {
- |
-
-
- 114 |
- 285x |
-
- checkmate::assert_string(arg)
- |
-
-
- 115 |
- 282x |
-
- if (inherits(modules, "teal_modules")) {
- |
-
-
- 116 |
- 19x |
-
- any(unlist(lapply(modules$children, is_arg_used, arg)))
- |
-
-
- 117 |
- 263x |
-
- } else if (inherits(modules, "teal_module")) {
- |
-
-
- 118 |
- 32x |
-
- is_arg_used(modules$server, arg) || is_arg_used(modules$ui, arg)
- |
-
-
- 119 |
- 231x |
-
- } else if (is.function(modules)) {
- |
-
-
- 120 |
- 229x |
-
- isTRUE(arg %in% names(formals(modules)))
- |
-
-
- 121 |
- |
-
- } else {
- |
-
-
- 122 |
- 2x |
-
- stop("is_arg_used function not implemented for this object")
- |
-
-
- 123 |
- |
-
- }
- |
-
-
- 124 |
- |
-
- }
- |
-
-
- 125 |
- |
-
-
- |
-
-
- 126 |
- |
-
-
- |
-
-
- 127 |
- |
-
- #' Creates a `teal_module` object.
- |
-
-
- 128 |
- |
-
- #'
- |
-
-
- 129 |
- |
-
- #' @description `r lifecycle::badge("stable")`
- |
-
-
- 130 |
- |
-
- #' This function embeds a `shiny` module inside a `teal` application. One `teal_module` maps to one `shiny` module.
- |
-
-
- 131 |
- |
-
- #'
- |
-
-
- 132 |
- |
-
- #' @param label (`character(1)`) Label shown in the navigation item for the module. Any label possible except
- |
-
-
- 133 |
- |
-
- #' `"global_filters"` - read more in `mapping` argument of [teal::teal_slices].
- |
-
-
- 134 |
- |
-
- #' @param server (`function`) `shiny` module with following arguments:
- |
-
-
- 135 |
- |
-
- #' - `id` - teal will set proper shiny namespace for this module (see [shiny::moduleServer()]).
- |
-
-
- 136 |
- |
-
- #' - `input`, `output`, `session` - (not recommended) then [shiny::callModule()] will be used to call a module.
- |
-
-
- 137 |
- |
-
- #' - `data` (optional) module will receive a `tdata` object, a list of reactive (filtered) data specified in
- |
-
-
- 138 |
- |
-
- #' the `filters` argument.
- |
-
-
- 139 |
- |
-
- #' - `datasets` (optional) module will receive `FilteredData`. (See `[teal.slice::FilteredData]`).
- |
-
-
- 140 |
- |
-
- #' - `reporter` (optional) module will receive `Reporter`. (See [teal.reporter::Reporter]).
- |
-
-
- 141 |
- |
-
- # - `filter_panel_api` (optional) module will receive `FilterPanelAPI`. (See [teal.slice::FilterPanelAPI]).
- |
-
-
- 142 |
- |
-
- #' - `...` (optional) `server_args` elements will be passed to the module named argument or to the `...`.
- |
-
-
- 143 |
- |
-
- #' @param ui (`function`) Shiny `ui` module function with following arguments:
- |
-
-
- 144 |
- |
-
- #' - `id` - teal will set proper shiny namespace for this module.
- |
-
-
- 145 |
- |
-
- #' - `data` (optional) module will receive list of reactive (filtered) data specified in the `filters` argument.
- |
-
-
- 146 |
- |
-
- #' - `datasets` (optional) module will receive `FilteredData`. (See `[teal.slice::FilteredData]`).
- |
-
-
- 147 |
- |
-
- #' - `...` (optional) `ui_args` elements will be passed to the module named argument or to the `...`.
- |
-
-
- 148 |
- |
-
- #' @param filters (`character`) Deprecated. Use `datanames` instead.
- |
-
-
- 149 |
- |
-
- #' @param datanames (`character`) A vector with `datanames` that are relevant for the item. The
- |
-
-
- 150 |
- |
-
- #' filter panel will automatically update the shown filters to include only
- |
-
-
- 151 |
- |
-
- #' filters in the listed datasets. `NULL` will hide the filter panel,
- |
-
-
- 152 |
- |
-
- #' and the keyword `'all'` will show filters of all datasets. `datanames` also determines
- |
-
-
- 153 |
- |
-
- #' a subset of datasets which are appended to the `data` argument in `server` function.
- |
-
-
- 154 |
- |
-
- #' @param server_args (named `list`) with additional arguments passed on to the
- |
-
-
- 155 |
- |
-
- #' `server` function.
- |
-
-
- 156 |
- |
-
- #' @param ui_args (named `list`) with additional arguments passed on to the
- |
-
-
- 157 |
- |
-
- #' `ui` function.
- |
-
-
- 158 |
- |
-
- #'
- |
-
-
- 159 |
- |
-
- #' @return object of class `teal_module`.
- |
-
-
- 160 |
- |
-
- #' @export
- |
-
-
- 161 |
- |
-
- #' @examples
- |
-
-
- 162 |
- |
-
- #' library(shiny)
- |
-
-
- 163 |
- |
-
- #'
- |
-
-
- 164 |
- |
-
- #' app <- init(
- |
-
-
- 165 |
- |
-
- #' data = teal_data(dataset("iris", iris)),
- |
-
-
- 166 |
- |
-
- #' modules = list(
- |
-
-
- 167 |
- |
-
- #' module(
- |
-
-
- 168 |
- |
-
- #' label = "Module",
- |
-
-
- 169 |
- |
-
- #' server = function(id, data) {
- |
-
-
- 170 |
- |
-
- #' moduleServer(
- |
-
-
- 171 |
- |
-
- #' id,
- |
-
-
- 172 |
- |
-
- #' module = function(input, output, session) {
- |
-
-
- 173 |
- |
-
- #' output$data <- renderDataTable(data[["iris"]]())
- |
-
-
- 174 |
- |
-
- #' }
- |
-
-
- 175 |
- |
-
- #' )
- |
-
-
- 176 |
- |
-
- #' },
- |
-
-
- 177 |
- |
-
- #' ui = function(id) {
- |
-
-
- 178 |
- |
-
- #' ns <- NS(id)
- |
-
-
- 179 |
- |
-
- #' tagList(dataTableOutput(ns("data")))
- |
-
-
- 180 |
- |
-
- #' }
- |
-
-
- 181 |
- |
-
- #' )
- |
-
-
- 182 |
- |
-
- #' )
- |
-
-
- 183 |
- |
-
- #' )
- |
-
-
- 184 |
- |
-
- #' if (interactive()) {
- |
-
-
- 185 |
- |
-
- #' runApp(app)
- |
-
-
- 186 |
- |
-
- #' }
- |
-
-
- 187 |
- |
-
- module <- function(label = "module",
- |
-
-
- 188 |
- |
-
- server = function(id, ...) {
- |
-
-
- 189 |
- 1x |
-
- moduleServer(id, function(input, output, session) {}) # nolint
- |
-
-
- 190 |
- |
-
- },
- |
-
-
- 191 |
- |
-
- ui = function(id, ...) {
- |
-
-
- 192 |
- 1x |
-
- tags$p(paste0("This module has no UI (id: ", id, " )"))
- |
-
-
- 193 |
- |
-
- },
- |
-
-
- 194 |
- |
-
- filters,
- |
-
-
- 195 |
- |
-
- datanames = "all",
- |
-
-
- 196 |
- |
-
- server_args = NULL,
- |
-
-
- 197 |
- |
-
- ui_args = NULL) {
- |
-
-
- 198 |
- 109x |
-
- checkmate::assert_string(label)
- |
-
-
- 199 |
- 106x |
-
- checkmate::assert_function(server)
- |
-
-
- 200 |
- 106x |
-
- checkmate::assert_function(ui)
- |
-
-
- 201 |
- 106x |
-
- checkmate::assert_character(datanames, min.len = 1, null.ok = TRUE, any.missing = FALSE)
- |
-
-
- 202 |
- 105x |
-
- checkmate::assert_list(server_args, null.ok = TRUE, names = "named")
- |
-
-
- 203 |
- 103x |
-
- checkmate::assert_list(ui_args, null.ok = TRUE, names = "named")
- |
-
-
- 204 |
- |
-
-
- |
-
-
- 205 |
- 101x |
-
- if (!missing(filters)) {
- |
-
-
- 206 |
- ! |
-
- checkmate::assert_character(filters, min.len = 1, null.ok = TRUE, any.missing = FALSE)
- |
-
-
- 207 |
- ! |
-
- datanames <- filters
- |
-
-
- 208 |
- ! |
-
- msg <-
- |
-
-
- 209 |
- ! |
-
- "The `filters` argument is deprecated and will be removed in the next release. Please use `datanames` instead."
- |
-
-
- 210 |
- ! |
-
- logger::log_warn(msg)
- |
-
-
- 211 |
- ! |
-
- warning(msg)
- |
-
-
- 212 |
- |
-
- }
- |
-
-
- 213 |
- |
-
-
- |
-
-
- 214 |
- 101x |
-
- if (label == "global_filters") {
- |
-
-
- 215 |
- 1x |
-
- stop("Label 'global_filters' is reserved in teal. Please change to something else.")
- |
-
-
- 216 |
- |
-
- }
- |
-
-
- 217 |
- 100x |
-
- server_formals <- names(formals(server))
- |
-
-
- 218 |
- 100x |
-
- if (!(
- |
-
-
- 219 |
- 100x |
-
- "id" %in% server_formals ||
- |
-
-
- 220 |
- 100x |
-
- all(c("input", "output", "session") %in% server_formals)
- |
-
-
- 221 |
- |
-
- )) {
- |
-
-
- 222 |
- 2x |
-
- stop(
- |
-
-
- 223 |
- 2x |
-
- "\nmodule() `server` argument requires a function with following arguments:",
- |
-
-
- 224 |
- 2x |
-
- "\n - id - teal will set proper shiny namespace for this module.",
- |
-
-
- 225 |
- 2x |
-
- "\n - input, output, session (not recommended) - then shiny::callModule will be used to call a module.",
- |
-
-
- 226 |
- 2x |
-
- "\n\nFollowing arguments can be used optionaly:",
- |
-
-
- 227 |
- 2x |
-
- "\n - `data` - module will receive list of reactive (filtered) data specified in the `filters` argument",
- |
-
-
- 228 |
- 2x |
-
- "\n - `datasets` - module will receive `FilteredData`. See `help(teal.slice::FilteredData)`",
- |
-
-
- 229 |
- 2x |
-
- "\n - `reporter` - module will receive `Reporter`. See `help(teal.reporter::Reporter)`",
- |
-
-
- 230 |
- 2x |
-
- "\n - `filter_panel_api` - module will receive `FilterPanelAPI`. (See [teal.slice::FilterPanelAPI]).",
- |
-
-
- 231 |
- 2x |
-
- "\n - `...` server_args elements will be passed to the module named argument or to the `...`"
- |
-
-
- 232 |
- |
-
- )
- |
-
-
- 233 |
- |
-
- }
- |
-
-
- 234 |
- |
-
-
- |
-
-
- 235 |
- 98x |
-
- if (!is.element("data", server_formals)) {
- |
-
-
- 236 |
- 71x |
-
- message(sprintf("module \"%s\" server function takes no data so \"datanames\" will be ignored", label))
- |
-
-
- 237 |
- 71x |
-
- datanames <- NULL
- |
-
-
- 238 |
- |
-
- }
- |
-
-
- 239 |
- |
-
-
- |
-
-
- 240 |
- 98x |
-
- srv_extra_args <- setdiff(names(server_args), server_formals)
- |
-
-
- 241 |
- 98x |
-
- if (length(srv_extra_args) > 0 && !"..." %in% server_formals) {
- |
-
-
- 242 |
- 1x |
-
- stop(
- |
-
-
- 243 |
- 1x |
-
- "\nFollowing `server_args` elements have no equivalent in the formals of the `server`:\n",
- |
-
-
- 244 |
- 1x |
-
- paste(paste(" -", srv_extra_args), collapse = "\n"),
- |
-
-
- 245 |
- 1x |
-
- "\n\nUpdate the `server` arguments by including above or add `...`"
- |
-
-
- 246 |
- |
-
- )
- |
-
-
- 247 |
- |
-
- }
- |
-
-
- 248 |
- |
-
-
- |
-
-
- 249 |
- 97x |
-
- ui_formals <- names(formals(ui))
- |
-
-
- 250 |
- 97x |
-
- if (!"id" %in% ui_formals) {
- |
-
-
- 251 |
- 1x |
-
- stop(
- |
-
-
- 252 |
- 1x |
-
- "\nmodule() `ui` argument requires a function with following arguments:",
- |
-
-
- 253 |
- 1x |
-
- "\n - id - teal will set proper shiny namespace for this module.",
- |
-
-
- 254 |
- 1x |
-
- "\n\nFollowing arguments can be used optionaly:",
- |
-
-
- 255 |
- 1x |
-
- "\n - `data` - module will receive list of reactive (filtered) data specied in the `filters` argument",
- |
-
-
- 256 |
- 1x |
-
- "\n - `datasets` - module will receive `FilteredData`. See `help(teal.slice::FilteredData)`",
- |
-
-
- 257 |
- 1x |
-
- "\n - `...` ui_args elements will be passed to the module argument of the same name or to the `...`"
- |
-
-
- 258 |
- |
-
- )
- |
-
-
- 259 |
- |
-
- }
- |
-
-
- 260 |
- |
-
-
- |
-
-
- 261 |
- 96x |
-
- ui_extra_args <- setdiff(names(ui_args), ui_formals)
- |
-
-
- 262 |
- 96x |
-
- if (length(ui_extra_args) > 0 && !"..." %in% ui_formals) {
- |
-
-
- 263 |
- 1x |
-
- stop(
- |
-
-
- 264 |
- 1x |
-
- "\nFollowing `ui_args` elements have no equivalent in the formals of `ui`:\n",
- |
-
-
- 265 |
- 1x |
-
- paste(paste(" -", ui_extra_args), collapse = "\n"),
- |
-
-
- 266 |
- 1x |
-
- "\n\nUpdate the `ui` arguments by including above or add `...`"
- |
-
-
- 267 |
- |
-
- )
- |
-
-
- 268 |
- |
-
- }
- |
-
-
- 269 |
- |
-
-
- |
-
-
- 270 |
- 95x |
-
- structure(
- |
-
-
- 271 |
- 95x |
-
- list(
- |
-
-
- 272 |
- 95x |
-
- label = label,
- |
-
-
- 273 |
- 95x |
-
- server = server, ui = ui, datanames = datanames,
- |
-
-
- 274 |
- 95x |
-
- server_args = server_args, ui_args = ui_args
- |
-
-
- 275 |
- |
-
- ),
- |
-
-
- 276 |
- 95x |
-
- class = "teal_module"
- |
-
-
- 277 |
- |
-
- )
- |
-
-
- 278 |
- |
-
- }
- |
-
-
- 279 |
- |
-
-
- |
-
-
- 280 |
- |
-
-
- |
-
-
- 281 |
- |
-
- #' Get module depth
- |
-
-
- 282 |
- |
-
- #'
- |
-
-
- 283 |
- |
-
- #' Depth starts at 0, so a single `teal.module` has depth 0.
- |
-
-
- 284 |
- |
-
- #' Nesting it increases overall depth by 1.
- |
-
-
- 285 |
- |
-
- #'
- |
-
-
- 286 |
- |
-
- #' @inheritParams init
- |
-
-
- 287 |
- |
-
- #' @param depth optional, integer determining current depth level
- |
-
-
- 288 |
- |
-
- #'
- |
-
-
- 289 |
- |
-
- #' @return depth level for given module
- |
-
-
- 290 |
- |
-
- #' @keywords internal
- |
-
-
- 291 |
- |
-
- #'
- |
-
-
- 292 |
- |
-
- #' @examples
- |
-
-
- 293 |
- |
-
- #' mods <- modules(
- |
-
-
- 294 |
- |
-
- #' label = "d1",
- |
-
-
- 295 |
- |
-
- #' modules(
- |
-
-
- 296 |
- |
-
- #' label = "d2",
- |
-
-
- 297 |
- |
-
- #' modules(
- |
-
-
- 298 |
- |
-
- #' label = "d3",
- |
-
-
- 299 |
- |
-
- #' module(label = "aaa1"), module(label = "aaa2"), module(label = "aaa3")
- |
-
-
- 300 |
- |
-
- #' ),
- |
-
-
- 301 |
- |
-
- #' module(label = "bbb")
- |
-
-
- 302 |
- |
-
- #' ),
- |
-
-
- 303 |
- |
-
- #' module(label = "ccc")
- |
-
-
- 304 |
- |
-
- #' )
- |
-
-
- 305 |
- |
-
- #' stopifnot(teal:::modules_depth(mods) == 3L)
- |
-
-
- 306 |
- |
-
- #'
- |
-
-
- 307 |
- |
-
- #' mods <- modules(
- |
-
-
- 308 |
- |
-
- #' label = "a",
- |
-
-
- 309 |
- |
-
- #' modules(
- |
-
-
- 310 |
- |
-
- #' label = "b1", module(label = "c")
- |
-
-
- 311 |
- |
-
- #' ),
- |
-
-
- 312 |
- |
-
- #' module(label = "b2")
- |
-
-
- 313 |
- |
-
- #' )
- |
-
-
- 314 |
- |
-
- #' stopifnot(teal:::modules_depth(mods) == 2L)
- |
-
-
- 315 |
- |
-
- modules_depth <- function(modules, depth = 0L) {
- |
-
-
- 316 |
- 12x |
-
- checkmate::assert(
- |
-
-
- 317 |
- 12x |
-
- checkmate::check_class(modules, "teal_module"),
- |
-
-
- 318 |
- 12x |
-
- checkmate::check_class(modules, "teal_modules")
- |
-
-
- 319 |
- |
-
- )
- |
-
-
- 320 |
- 12x |
-
- checkmate::assert_int(depth, lower = 0)
- |
-
-
- 321 |
- 11x |
-
- if (inherits(modules, "teal_modules")) {
- |
-
-
- 322 |
- 4x |
-
- max(vapply(modules$children, modules_depth, integer(1), depth = depth + 1L))
- |
-
-
- 323 |
- |
-
- } else {
- |
-
-
- 324 |
- 7x |
-
- depth
- |
-
-
- 325 |
- |
-
- }
- |
-
-
- 326 |
- |
-
- }
- |
-
-
- 327 |
- |
-
-
- |
-
-
- 328 |
- |
-
-
- |
-
-
- 329 |
- |
-
- module_labels <- function(modules) {
- |
-
-
- 330 |
- ! |
-
- if (inherits(modules, "teal_modules")) {
- |
-
-
- 331 |
- ! |
-
- lapply(modules$children, module_labels)
- |
-
-
- 332 |
- |
-
- } else {
- |
-
-
- 333 |
- ! |
-
- modules$label
- |
-
-
- 334 |
- |
-
- }
- |
-
-
- 335 |
- |
-
- }
- |
-
-
- 336 |
- |
-
-
- |
-
-
- 337 |
- |
-
- #' Converts `teal_modules` to a string
- |
-
-
- 338 |
- |
-
- #'
- |
-
-
- 339 |
- |
-
- #' @param x (`teal_modules`) to print
- |
-
-
- 340 |
- |
-
- #' @param indent (`integer`) indent level;
- |
-
-
- 341 |
- |
-
- #' each `submodule` is indented one level more
- |
-
-
- 342 |
- |
-
- #' @param ... (optional) additional parameters to pass to recursive calls of `toString`
- |
-
-
- 343 |
- |
-
- #' @return (`character`)
- |
-
-
- 344 |
- |
-
- #' @export
- |
-
-
- 345 |
- |
-
- #' @rdname modules
- |
-
-
- 346 |
- |
-
- toString.teal_modules <- function(x, indent = 0, ...) { # nolint
- |
-
-
- 347 |
- |
-
- # argument must be `x` to be consistent with base method
- |
-
-
- 348 |
- ! |
-
- paste(c(
- |
-
-
- 349 |
- ! |
-
- paste0(rep(" ", indent), "+ ", x$label),
- |
-
-
- 350 |
- ! |
-
- unlist(lapply(x$children, toString, indent = indent + 1, ...))
- |
-
-
- 351 |
- ! |
-
- ), collapse = "\n")
- |
-
-
- 352 |
- |
-
- }
- |
-
-
- 353 |
- |
-
-
- |
-
-
- 354 |
- |
-
- #' Converts `teal_module` to a string
- |
-
-
- 355 |
- |
-
- #'
- |
-
-
- 356 |
- |
-
- #' @inheritParams toString.teal_modules
- |
-
-
- 357 |
- |
-
- #' @param x `teal_module`
- |
-
-
- 358 |
- |
-
- #' @param ... ignored
- |
-
-
- 359 |
- |
-
- #' @export
- |
-
-
- 360 |
- |
-
- #' @rdname module
- |
-
-
- 361 |
- |
-
- toString.teal_module <- function(x, indent = 0, ...) { # nolint
- |
-
-
- 362 |
- ! |
-
- paste0(paste(rep(" ", indent), collapse = ""), "+ ", x$label, collapse = "")
- |
-
-
- 363 |
- |
-
- }
- |
-
-
- 364 |
- |
-
-
- |
-
-
- 365 |
- |
-
- #' Prints `teal_modules`
- |
-
-
- 366 |
- |
-
- #' @param x `teal_modules`
- |
-
-
- 367 |
- |
-
- #' @param ... parameters passed to `toString`
- |
-
-
- 368 |
- |
-
- #' @export
- |
-
-
- 369 |
- |
-
- #' @rdname modules
- |
-
-
- 370 |
- |
-
- print.teal_modules <- function(x, ...) {
- |
-
-
- 371 |
- ! |
-
- s <- toString(x, ...)
- |
-
-
- 372 |
- ! |
-
- cat(s)
- |
-
-
- 373 |
- ! |
-
- return(invisible(s))
- |
-
-
- 374 |
- |
-
- }
- |
-
-
- 375 |
- |
-
-
- |
-
-
- 376 |
- |
-
- #' Prints `teal_module`
- |
-
-
- 377 |
- |
-
- #' @param x `teal_module`
- |
-
-
- 378 |
- |
-
- #' @param ... parameters passed to `toString`
- |
-
-
- 379 |
- |
-
- #' @export
- |
-
-
- 380 |
- |
-
- #' @rdname module
- |
-
-
- 381 |
- |
-
- print.teal_module <- print.teal_modules
- |
-
-
-