#' Validate that dataset has a minimum number of observations

#'

#' This function is a wrapper for `shiny::validate`.

#'

#' @param x (`data.frame`)

#' @param min_nrow (`numeric(1)`) Minimum allowed number of rows in `x`.

#' @param complete (`logical(1)`) Flag specifying whether to check only complete cases. Defaults to `FALSE`.

#' @param allow_inf (`logical(1)`) Flag specifying whether to allow infinite values. Defaults to `TRUE`.

#' @param msg (`character(1)`) Additional message to display alongside the default message.

#'

#' @export

#'

#' @examplesShinylive

#' library(teal)

#' interactive <- function() TRUE

#' {{ next_example }}

#' @examples

#' library(teal)

#' ui <- fluidPage(

#'   sliderInput("len", "Max Length of Sepal",

#'     min = 4.3, max = 7.9, value = 5

#'   ),

#'   plotOutput("plot")

#' )

#'

#' server <- function(input, output) {

#'   output$plot <- renderPlot({

#'     iris_df <- iris[iris$Sepal.Length <= input$len, ]

#'     validate_has_data(

#'       iris_df,

#'       min_nrow = 10,

#'       complete = FALSE,

#'       msg = "Please adjust Max Length of Sepal"

#'     )

#'

#'     hist(iris_df$Sepal.Length, breaks = 5)

#'   })

#' }

#' if (interactive()) {

#'   shinyApp(ui, server)

#' }

#'

validate_has_data <- function(x,

                              min_nrow = NULL,

                              complete = FALSE,

                              allow_inf = TRUE,

                              msg = NULL) {

      ))

    } else {

        )

      ))

    }

      ))

    }

  }

}

#' Validate that dataset has unique rows for key variables

#'

#' This function is a wrapper for `shiny::validate`.

#'

#' @param x (`data.frame`)

#' @param key (`character`) Vector of ID variables from `x` that identify unique records.

#'

#' @export

#'

#' @examplesShinylive

#' library(teal)

#' interactive <- function() TRUE

#' {{ next_example }}

#' @examples

#' iris$id <- rep(1:50, times = 3)

#' ui <- fluidPage(

#'   selectInput(

#'     inputId = "species",

#'     label = "Select species",

#'     choices = c("setosa", "versicolor", "virginica"),

#'     selected = "setosa",

#'     multiple = TRUE

#'   ),

#'   plotOutput("plot")

#' )

#' server <- function(input, output) {

#'   output$plot <- renderPlot({

#'     iris_f <- iris[iris$Species %in% input$species, ]

#'     validate_one_row_per_id(iris_f, key = c("id"))

#'

#'     hist(iris_f$Sepal.Length, breaks = 5)

#'   })

#' }

#' if (interactive()) {

#'   shinyApp(ui, server)

#' }

#'

validate_one_row_per_id <- function(x, key = c("USUBJID", "STUDYID")) {

}

#' Validates that vector includes all expected values

#'

#' This function is a wrapper for `shiny::validate`.

#'

#' @param x Vector of values to test.

#' @param choices Vector to test against.

#' @param msg (`character(1)`) Error message to display if some elements of `x` are not elements of `choices`.

#'

#' @export

#'

#' @examplesShinylive

#' library(teal)

#' interactive <- function() TRUE

#' {{ next_example }}

#' @examples

#' ui <- fluidPage(

#'   selectInput(

#'     "species",

#'     "Select species",

#'     choices = c("setosa", "versicolor", "virginica", "unknown species"),

#'     selected = "setosa",

#'     multiple = FALSE

#'   ),

#'   verbatimTextOutput("summary")

#' )

#'

#' server <- function(input, output) {

#'   output$summary <- renderPrint({

#'     validate_in(input$species, iris$Species, "Species does not exist.")

#'     nrow(iris[iris$Species == input$species, ])

#'   })

#' }

#' if (interactive()) {

#'   shinyApp(ui, server)

#' }

#'

validate_in <- function(x, choices, msg) {

}

#' Validates that vector has length greater than 0

#'

#' This function is a wrapper for `shiny::validate`.

#'

#' @param x vector

#' @param msg message to display

#'

#' @export

#'

#' @examplesShinylive

#' library(teal)

#' interactive <- function() TRUE

#' {{ next_example }}

#' @examples

#' data <- data.frame(

#'   id = c(1:10, 11:20, 1:10),

#'   strata = rep(c("A", "B"), each = 15)

#' )

#' ui <- fluidPage(

#'   selectInput("ref1", "Select strata1 to compare",

#'     choices = c("A", "B", "C"), selected = "A"

#'   ),

#'   selectInput("ref2", "Select strata2 to compare",

#'     choices = c("A", "B", "C"), selected = "B"

#'   ),

#'   verbatimTextOutput("arm_summary")

#' )

#'

#' server <- function(input, output) {

#'   output$arm_summary <- renderText({

#'     sample_1 <- data$id[data$strata == input$ref1]

#'     sample_2 <- data$id[data$strata == input$ref2]

#'

#'     validate_has_elements(sample_1, "No subjects in strata1.")

#'     validate_has_elements(sample_2, "No subjects in strata2.")

#'

#'     paste0(

#'       "Number of samples in: strata1=", length(sample_1),

#'       " comparions strata2=", length(sample_2)

#'     )

#'   })

#' }

#' if (interactive()) {

#'   shinyApp(ui, server)

#' }

validate_has_elements <- function(x, msg) {

}

#' Validates no intersection between two vectors

#'

#' This function is a wrapper for `shiny::validate`.

#'

#' @param x vector

#' @param y vector

#' @param msg (`character(1)`) message to display if `x` and `y` intersect

#'

#' @export

#'

#' @examplesShinylive

#' library(teal)

#' interactive <- function() TRUE

#' {{ next_example }}

#' @examples

#' data <- data.frame(

#'   id = c(1:10, 11:20, 1:10),

#'   strata = rep(c("A", "B", "C"), each = 10)

#' )

#'

#' ui <- fluidPage(

#'   selectInput("ref1", "Select strata1 to compare",

#'     choices = c("A", "B", "C"),

#'     selected = "A"

#'   ),

#'   selectInput("ref2", "Select strata2 to compare",

#'     choices = c("A", "B", "C"),

#'     selected = "B"

#'   ),

#'   verbatimTextOutput("summary")

#' )

#'

#' server <- function(input, output) {

#'   output$summary <- renderText({

#'     sample_1 <- data$id[data$strata == input$ref1]

#'     sample_2 <- data$id[data$strata == input$ref2]

#'

#'     validate_no_intersection(

#'       sample_1, sample_2,

#'       "subjects within strata1 and strata2 cannot overlap"

#'     )

#'     paste0(

#'       "Number of subject in: reference treatment=", length(sample_1),

#'       " comparions treatment=", length(sample_2)

#'     )

#'   })

#' }

#' if (interactive()) {

#'   shinyApp(ui, server)

#' }

#'

validate_no_intersection <- function(x, y, msg) {

}

#' Validates that dataset contains specific variable

#'

#' This function is a wrapper for `shiny::validate`.

#'

#' @param data (`data.frame`)

#' @param varname (`character(1)`) name of variable to check for in `data`

#' @param msg (`character(1)`) message to display if `data` does not include `varname`

#'

#' @export

#'

#' @examplesShinylive

#' library(teal)

#' interactive <- function() TRUE

#' {{ next_example }}

#' @examples

#' data <- data.frame(

#'   one = rep("a", length.out = 20),

#'   two = rep(c("a", "b"), length.out = 20)

#' )

#' ui <- fluidPage(

#'   selectInput(

#'     "var",

#'     "Select variable",

#'     choices = c("one", "two", "three", "four"),

#'     selected = "one"

#'   ),

#'   verbatimTextOutput("summary")

#' )

#'

#' server <- function(input, output) {

#'   output$summary <- renderText({

#'     validate_has_variable(data, input$var)

#'     paste0("Selected treatment variables: ", paste(input$var, collapse = ", "))

#'   })

#' }

#' if (interactive()) {

#'   shinyApp(ui, server)

#' }

validate_has_variable <- function(data, varname, msg) {

        )

      }

    }

  }

}

#' Validate that variables has expected number of levels

#'

#' If the number of levels of `x` is less than `min_levels`

#' or greater than `max_levels` the validation will fail.

#' This function is a wrapper for `shiny::validate`.

#'

#' @param x variable name. If `x` is not a factor, the unique values

#'   are treated as levels.

#' @param min_levels cutoff for minimum number of levels of `x`

#' @param max_levels cutoff for maximum number of levels of `x`

#' @param var_name name of variable being validated for use in

#'   validation message

#'

#' @export

#'

#' @examplesShinylive

#' library(teal)

#' interactive <- function() TRUE

#' {{ next_example }}

#' @examples

#' data <- data.frame(

#'   one = rep("a", length.out = 20),

#'   two = rep(c("a", "b"), length.out = 20),

#'   three = rep(c("a", "b", "c"), length.out = 20),

#'   four = rep(c("a", "b", "c", "d"), length.out = 20),

#'   stringsAsFactors = TRUE

#' )

#' ui <- fluidPage(

#'   selectInput(

#'     "var",

#'     "Select variable",

#'     choices = c("one", "two", "three", "four"),

#'     selected = "one"

#'   ),

#'   verbatimTextOutput("summary")

#' )

#'

#' server <- function(input, output) {

#'   output$summary <- renderText({

#'     validate_n_levels(data[[input$var]], min_levels = 2, max_levels = 15, var_name = input$var)

#'     paste0(

#'       "Levels of selected treatment variable: ",

#'       paste(levels(data[[input$var]]),

#'         collapse = ", "

#'       )

#'     )

#'   })

#' }

#' if (interactive()) {

#'   shinyApp(ui, server)

#' }

validate_n_levels <- function(x, min_levels = 1, max_levels = 12, var_name) {

  } else {

  }

      )

    ))

    ))

    ))

  }

}

#' Data module for `teal` transformations and output customization

#'

#' @description

#' `r lifecycle::badge("experimental")`

#'

#' `teal_transform_module` provides a `shiny` module that enables data transformations within a `teal` application

#' and allows for customization of outputs generated by modules.

#'

#' # Transforming Module Inputs in `teal`

#'

#' Data transformations occur after data has been filtered in `teal`.

#' The transformed data is then passed to the `server` of [`teal_module()`] and managed by `teal`'s internal processes.

#' The primary advantage of `teal_transform_module` over custom modules is in its error handling, where all warnings and

#' errors are managed by `teal`, allowing developers to focus on transformation logic.

#'

#' For more details, see the vignette: `vignette("transform-input-data", package = "teal")`.

#'

#' # Customizing Module Outputs

#'

#' `teal_transform_module` also allows developers to modify any object created within [`teal.data::teal_data`].

#' This means you can use it to customize not only datasets but also tables, listings, and graphs.

#' Some [`teal_modules`] permit developers to inject custom `shiny` modules to enhance displayed outputs.

#' To manage these `decorators` within your module, see [`module_transform_data`].

#' (For further guidance on managing decorators, refer to `ui_args` and `srv_args` in the vignette documentation.)

#'

#' See the vignette `vignette("transform-module-output", package = "teal")` for additional examples.

#'

#' # `server` as a language

#'

#' The `server` function in `teal_transform_module` must return a reactive [`teal.data::teal_data`] object.

#' For simple transformations without complex reactivity, the `server` function might look like this:s

#'

#' ```

#' function(id, data) {

#'   moduleServer(id, function(input, output, session) {

#'     reactive({

#'       within(

#'         data(),

#'         expr = x <- subset(x, col == level),

#'         level = input$level

#'       )

#'     })

#'   })

#' }

#' ```

#'

#' The example above can be simplified using `make_teal_transform_server`, where `level` is automatically matched to the

#' corresponding `input` parameter:

#'

#' ```

#' make_teal_transform_server(expr = expression(x <- subset(x, col == level)))

#' ```

#' @inheritParams teal_data_module

#' @param server (`function(id, data)` or `expression`)

#' A `shiny` module server function that takes `id` and `data` as arguments, where `id` is the module id and `data`

#' is the reactive `teal_data` input. The `server` function must return a reactive expression containing a `teal_data`

#' object. For simplified syntax, use [`make_teal_transform_server()`].

#' @param datanames (`character`)

#' Specifies the names of datasets relevant to the module. Only filters for the specified `datanames` will be displayed

#' in the filter panel. The keyword `"all"` can be used to display filters for all datasets. `datanames` are

#' automatically appended to the [`modules()`] `datanames`.

#'

#' @examplesShinylive

#' library(teal)

#' interactive <- function() TRUE

#' {{ next_example }}

#' @examples

#' data_transformators <- list(

#'   teal_transform_module(

#'     label = "Static transformator for iris",

#'     datanames = "iris",

#'     server = function(id, data) {

#'       moduleServer(id, function(input, output, session) {

#'         reactive({

#'           within(data(), {

#'             iris <- head(iris, 5)

#'           })

#'         })

#'       })

#'     }

#'   ),

#'   teal_transform_module(

#'     label = "Interactive transformator for iris",

#'     datanames = "iris",

#'     ui = function(id) {

#'       ns <- NS(id)

#'       tags$div(

#'         numericInput(ns("n_cols"), "Show n columns", value = 5, min = 1, max = 5, step = 1)

#'       )

#'     },

#'     server = function(id, data) {

#'       moduleServer(id, function(input, output, session) {

#'         reactive({

#'           within(data(),

#'             {

#'               iris <- iris[, 1:n_cols]

#'             },

#'             n_cols = input$n_cols

#'           )

#'         })

#'       })

#'     }

#'   )

#' )

#'

#' output_decorator <- teal_transform_module(

#'   server = make_teal_transform_server(

#'     expression(

#'       object <- rev(object)

#'     )

#'   )

#' )

#'

#' app <- init(

#'   data = teal_data(iris = iris),

#'   modules = example_module(

#'     transformators = data_transformators,

#'     decorators = list(output_decorator)

#'   )

#' )

#' if (interactive()) {

#'   shinyApp(app$ui, app$server)

#' }

#'

#' @name teal_transform_module

#'

#' @export

teal_transform_module <- function(ui = NULL,

                                  server = function(id, data) data,

                                  label = "transform module",

                                  datanames = "all") {

          # This warning message partially detects when `eventReactive` is used in `data_module`.

          )

        }

        )

      }

    ),

  )

}

#' Make teal_transform_module's server

#'

#' A factory function to simplify creation of a [`teal_transform_module`]'s server. Specified `expr`

#' is wrapped in a shiny module function and output can be passed to the `server` argument in

#' [teal_transform_module()] call. Such a server function can be linked with ui and values from the

#' inputs can be used in the expression. Object names specified in the expression will be substituted

#' with the value of the respective input (matched by the name) - for example in

#' `expression(graph <- graph + ggtitle(title))` object `title` will be replaced with the value of

#' `input$title`.

#' @param expr (`language`)

#'  An R call which will be evaluated within [`teal.data::teal_data`] environment.

#' @return `function(id, data)` returning `shiny` module

#'

#' @examplesShinylive

#' library(teal)

#' interactive <- function() TRUE

#' {{ next_example }}

#' @examples

#'

#' trim_iris <- teal_transform_module(

#'   label = "Simplified interactive transformator for iris",

#'   datanames = "iris",

#'   ui = function(id) {

#'     ns <- NS(id)

#'     numericInput(ns("n_rows"), "Subset n rows", value = 6, min = 1, max = 150, step = 1)

#'   },

#'   server = make_teal_transform_server(expression(iris <- head(iris, n_rows)))

#' )

#'

#' app <- init(

#'   data = teal_data(iris = iris),

#'   modules = example_module(transformators = trim_iris)

#' )

#' if (interactive()) {

#'   shinyApp(app$ui, app$server)

#' }

#'

#' @export

make_teal_transform_server <- function(expr) {

  }

      )

        })

      })

    })

  }

}

#' Extract all `transformators` from `modules`.

#'

#' @param modules `teal_modules` or `teal_module`

#' @return A list of `teal_transform_module` nested in the same way as input `modules`.

#' @keywords internal

extract_transformators <- function(modules) {

  }

}

#' `teal` main module

#'

#' @description

#' Module to create a `teal` app as a Shiny Module.

#'

#' @details

#' This module can be used instead of [init()] in custom Shiny applications. Unlike [init()], it doesn't

#' automatically include [`module_session_info`].

#'

#' Module is responsible for creating the main `shiny` app layout and initializing all the necessary

#' components. This module establishes reactive connection between the input `data` and every other

#' component in the app. Reactive change of the `data` passed as an argument, reloads the app and

#' possibly keeps all input settings the same so the user can continue where one left off.

#'

#' ## data flow in `teal` application

#'

#' This module supports multiple data inputs but eventually, they are all converted to `reactive`

#' returning `teal_data` in this module. On this `reactive teal_data` object several actions are

#' performed:

#' - data loading

#' - data filtering

#' - data transformation

#'

#' ## Fallback on failure

#'

#' `teal` is designed in such way that app will never crash if the error is introduced in any

#' custom `shiny` module provided by app developer (e.g. [teal_data_module()], [teal_transform_module()]).

#' If any module returns a failing object, the app will halt the evaluation and display a warning message.

#' App user should always have a chance to fix the improper input and continue without restarting the session.

#'

#' @rdname module_teal

#' @name module_teal

#'

#' @inheritParams init

#' @param id (`character(1)`) `shiny` module instance id.

#' @param data (`teal_data`, `teal_data_module`, or `reactive` returning `teal_data`)

#' The data which application will depend on.

#' @param modules (`teal_modules`)

#'   `teal_modules` object. These are the specific output modules which

#'   will be displayed in the `teal` application. See [modules()] and [module()] for

#'   more details.

#'

#' @return `NULL` invisibly

NULL

#' @rdname module_teal

#' @export

ui_teal <- function(id, modules) {

  # show busy icon when `shiny` session is busy computing stuff

  # based on https://stackoverflow.com/questions/17325521/r-shiny-display-loading-message-while-function-is-running/22475216#22475216 # nolint: line_length.

    )

  )

          },

          },

          },

          }

        )

      )

    }),

  )

  )

}

#' @rdname module_teal

#' @export

srv_teal <- function(id, data, modules, filter = teal_slices(), reporter = teal.reporter::Reporter$new()) {

      }

    })

    }

    })

    # set timezone in shiny app

    # timezone is set in the early beginning so it will be available also

    # for `DDL` and all shiny modules

      }

    )

    )

      # reactive as data_load_status determines if modal opens/reopens with disabled "dismiss" btn

          ),

            } else {

            }

          )

        )

      )

    })

    }

        )

      }

    })

      )

    }

      } else {

      }

    })

      # We want to exclude teal_data_module elements from bookmarking as they might have some secrets

              )

            ),

          )

        }

      })

      })

          )

        )

          {

            } else {

            }

          }

        )

      }

    } else {

      # when no teal_data_module then we want to display messages above tabsetPanel (because there is no data-tab)

      )

    }

    # Wait for UI to be rendered before showing/hiding reporter UI elements

    # See: https://github.com/rstudio/shiny/issues/3348

      {

          }

        } else {

        }

      }

    )

      })

    }

    )

  })

}

#' Adds signature protection to the `datanames` in the data

#' @param data (`teal_data`)

#' @return `teal_data` with additional code that has signature of the `datanames`

#' @keywords internal

.add_signature_to_data <- function(data) {

    )

  }

      ),

      )

    )

  )

}

#' Get code that tests the integrity of the reproducible data

#'

#' @param data (`teal_data`) object holding the data

#' @param datanames (`character`) names of `datasets`

#'

#' @return A character vector with the code lines.

#' @keywords internal

#'

.get_hashes_code <- function(data, datanames = names(data)) {

      } else {

      }

      )

    },

  )

}

.teal_data_module_id <- "teal_data_module"

# This is the main function from teal to be used by the end-users. Although it delegates

# directly to `module_teal_with_splash.R`, we keep it in a separate file because its documentation is quite large

# and it is very end-user oriented. It may also perform more argument checking with more informative

# error messages.

#' Create the server and UI function for the `shiny` app

#'

#' @description

#'

#' End-users: This is the most important function for you to start a

#' `teal` app that is composed of `teal` modules.

#'

#' @param data (`teal_data` or `teal_data_module`)

#'   For constructing the data object, refer to [teal.data::teal_data()] and [teal_data_module()].

#' @param modules (`list` or `teal_modules` or `teal_module`)

#'   Nested list of `teal_modules` or `teal_module` objects or a single

#'   `teal_modules` or `teal_module` object. These are the specific output modules which

#'   will be displayed in the `teal` application. See [modules()] and [module()] for

#'   more details.

#' @param filter (`teal_slices`) Optionally,

#'   specifies the initial filter using [teal_slices()].

#' @param title (`shiny.tag` or `character(1)`) `r lifecycle::badge("deprecated")` Optionally,

#'   the browser window title. Defaults to a title "teal app" with the icon of NEST.

#'   Can be created using the `build_app_title()` or

#'   by passing a valid `shiny.tag` which is a head tag with title and link tag.

#'   This parameter is no longer supported. Use `modify_title()` on the teal app object instead.

#' @param header (`shiny.tag` or `character(1)`) `r lifecycle::badge("deprecated")` Optionally,

#'   the header of the app.

#'   This parameter is no longer supported. Use `modify_header()` on the teal app object instead.

#' @param footer (`shiny.tag` or `character(1)`) `r lifecycle::badge("deprecated")` Optionally,

#'   the footer of the app.

#'   This parameter is no longer supported. Use `modify_footer()` on the teal app object instead.

#' @param id `r lifecycle::badge("deprecated")` (`character`) Optionally,

#'   a string specifying the `shiny` module id in cases it is used as a `shiny` module

#'   rather than a standalone `shiny` app.

#'   This parameter is no longer supported. Use [ui_teal()] and [srv_teal()] instead.

#' @param reporter (`Reporter`) object used to store report contents. Set to `NULL` to globally disable reporting.

#'

#' @return Named list containing server and UI functions.

#'

#' @export

#'

#' @include modules.R

#'

#' @examplesShinylive

#' library(teal)

#' interactive <- function() TRUE

#' {{ next_example }}

#' @examples

#' app <- init(

#'   data = within(

#'     teal_data(),

#'     {

#'       new_iris <- transform(iris, id = seq_len(nrow(iris)))

#'       new_mtcars <- transform(mtcars, id = seq_len(nrow(mtcars)))

#'     }

#'   ),

#'   modules = modules(

#'     module(

#'       label = "data source",

#'       server = function(input, output, session, data) {},

#'       ui = function(id, ...) tags$div(p("information about data source")),

#'       datanames = "all"

#'     ),

#'     example_module(label = "example teal module"),

#'     module(

#'       "Iris Sepal.Length histogram",

#'       server = function(input, output, session, data) {

#'         output$hist <- renderPlot(

#'           hist(data()[["new_iris"]]$Sepal.Length)

#'         )

#'       },

#'       ui = function(id, ...) {

#'         ns <- NS(id)

#'         plotOutput(ns("hist"))

#'       },

#'       datanames = "new_iris"

#'     )

#'   ),

#'   filter = teal_slices(

#'     teal_slice(dataname = "new_iris", varname = "Species"),

#'     teal_slice(dataname = "new_iris", varname = "Sepal.Length"),

#'     teal_slice(dataname = "new_mtcars", varname = "cyl"),

#'     exclude_varnames = list(new_iris = c("Sepal.Width", "Petal.Width")),

#'     module_specific = TRUE,

#'     mapping = list(

#'       `example teal module` = "new_iris Species",

#'       `Iris Sepal.Length histogram` = "new_iris Species",

#'       global_filters = "new_mtcars cyl"

#'     )

#'   )

#' )

#' if (interactive()) {

#'   shinyApp(app$ui, app$server)

#' }

#'

init <- function(data,

                 modules,

                 filter = teal_slices(),

                 title = lifecycle::deprecated(),

                 header = lifecycle::deprecated(),

                 footer = lifecycle::deprecated(),

                 id = lifecycle::deprecated(),

                 reporter = teal.reporter::Reporter$new()) {

  # argument checking (independent)

  ## `data`

  ## `modules`

  )

  }

  }

  ## `filter`

  # log

  ## `filter` - set app_id attribute unless present (when restoring bookmark)

  ## `filter` - convert teal.slice::teal_slices to teal::teal_slices

  # argument checking (interdependent)

  ## `filter` - `modules`

        )

      )

    }

      # In teal we are able to set nested modules with duplicated label.

      # Because mapping argument bases on the relationship between module-label and filter-id,

      # it is possible that module-label in mapping might refer to multiple teal_module (identified by the same label)

        )

      )

    }

  }

  ## `data` - `modules`

    }

    }

      # we allow app to continue if applied filters are outside

      # of possible data range

    }

  }

  # argument transformations

      )

    )

  } else {

  }

  # Note: UI must be a function to support bookmarking.

              )

            )

          ),

          ),

          ),

          )

        )

      },

        )

      }

    ),

  )

      )

    )

  }

      )

    )

  }

      )

    )

  }

}

#' Filter state snapshot management

#'

#' Capture and restore snapshots of the global (app) filter state.

#'

#' This module introduces snapshots: stored descriptions of the filter state of the entire application.

#' Snapshots allow the user to save the current filter state of the application for later use in the session,

#' as well as to save it to file in order to share it with an app developer or other users,

#' who in turn can upload it to their own session.

#'

#' The snapshot manager is accessed with the camera icon in the tabset bar.

#' At the beginning of a session it presents three icons: a camera, an upload, and an circular arrow.

#' Clicking the camera captures a snapshot, clicking the upload adds a snapshot from a file

#' and applies the filter states therein, and clicking the arrow resets initial application state.

#' As snapshots are added, they will show up as rows in a table and each will have a select button and a save button.

#'

#' @section Server logic:

#' Snapshots are basically `teal_slices` objects, however, since each module is served by a separate instance

#' of `FilteredData` and these objects require shared state, `teal_slice` is a `reactiveVal` so `teal_slices`

#' cannot be stored as is. Therefore, `teal_slices` are reversibly converted to a list of lists representation

#' (attributes are maintained).

#'

#' Snapshots are stored in a `reactiveVal` as a named list.

#' The first snapshot is the initial state of the application and the user can add a snapshot whenever they see fit.

#'

#' For every snapshot except the initial one, a piece of UI is generated that contains

#' the snapshot name, a select button to restore that snapshot, and a save button to save it to a file.

#' The initial snapshot is restored by a separate "reset" button.

#' It cannot be saved directly but a user is welcome to capture the initial state as a snapshot and save that.

#'

#' @section Snapshot mechanics:

#' When a snapshot is captured, the user is prompted to name it.

#' Names are displayed as is but since they are used to create button ids,

#' under the hood they are converted to syntactically valid strings.

#' New snapshot names are validated so that their valid versions are unique.

#' Leading and trailing white space is trimmed.

#'

#' The module can read the global state of the application from `slices_global` and `mapping_matrix`.

#' The former provides a list of all existing `teal_slice`s and the latter says which slice is active in which module.

#' Once a name has been accepted, `slices_global` is converted to a list of lists - a snapshot.

#' The snapshot contains the `mapping` attribute of the initial application state

#' (or one that has been restored), which may not reflect the current one,

#' so `mapping_matrix` is transformed to obtain the current mapping, i.e. a list that,

#' when passed to the `mapping` argument of [teal_slices()], would result in the current mapping.

#' This is substituted as the snapshot's `mapping` attribute and the snapshot is added to the snapshot list.

#'

#' To restore app state, a snapshot is retrieved from storage and rebuilt into a `teal_slices` object.

#' Then state of all `FilteredData` objects (provided in `datasets`) is cleared

#' and set anew according to the `mapping` attribute of the snapshot.

#' The snapshot is then set as the current content of `slices_global`.

#'

#' To save a snapshot, the snapshot is retrieved and reassembled just like for restoring,

#' and then saved to file with [slices_store()].

#'

#' When a snapshot is uploaded, it will first be added to storage just like a newly created one,

#' and then used to restore app state much like a snapshot taken from storage.

#' Upon clicking the upload icon the user will be prompted for a file to upload

#' and may choose to name the new snapshot. The name defaults to the name of the file (the extension is dropped)

#' and normal naming rules apply. Loading the file yields a `teal_slices` object,

#' which is disassembled for storage and used directly for restoring app state.

#'

#' @section Transferring snapshots:

#' Snapshots uploaded from disk should only be used in the same application they come from,

#' _i.e._ an application that uses the same data and the same modules.

#' To ensure this is the case, `init` stamps `teal_slices` with an app id that is stored in the `app_id` attribute of

#' a `teal_slices` object. When a snapshot is restored from file, its `app_id` is compared to that

#' of the current app state and only if the match is the snapshot admitted to the session.

#'

#' @section Bookmarks:

#' An `onBookmark` callback creates a snapshot of the current filter state.

#' This is done on the app session, not the module session.

#' (The snapshot will be retrieved by `module_teal` in order to set initial app state in a restored app.)

#' Then that snapshot, and the previous snapshot history are dumped into the `values.rds` file in `<bookmark_dir>`.

#'

#' @section Disabling the snapshot manager:

#' The snapshot manager can be turned off application-wide by setting the

#' `teal.snapshot_manager.enable` option to `FALSE`. When disabled, both

#' `ui_snapshot_manager_panel()` and `srv_snapshot_manager_panel()` return `NULL`,

#' so the camera icon is not rendered and no snapshot logic is attached.

#' The option defaults to `TRUE` and is set when the `teal` package is loaded.

#'

#' @param id (`character(1)`) `shiny` module instance id.

#' @param slices_global (`reactiveVal`) that contains a `teal_slices` object

#'                      containing all `teal_slice`s existing in the app, both active and inactive.

#'

#' @return `list` containing the snapshot history, where each element is an unlisted `teal_slices` object.

#'

#' @name module_snapshot_manager

#' @rdname module_snapshot_manager

#'

#' @author Aleksander Chlebowski

#' @keywords internal

NULL

#' @rdname module_snapshot_manager

ui_snapshot_manager_panel <- function(id) {

  }

  )

}

#' @rdname module_snapshot_manager

srv_snapshot_manager_panel <- function(id, slices_global) {

  }

        )

      )

    })

  })

}

#' @rdname module_snapshot_manager

ui_snapshot_manager <- function(id) {

      ),

      ),

      ),

    ),

  )

}

#' @rdname module_snapshot_manager

srv_snapshot_manager <- function(id, slices_global) {