tests/testthat/test-module_teal.R

In teal: Exploratory Web Apps for Analyzing Clinical Trials Data

# comment: srv_teal is exported so the tests here are extensive and cover srv_data as well.
#          testing of srv_data is not needed.
module_summary_table <<- function(output, id) {
  testthat::skip_if_not_installed("rvest")
  table_id <- sprintf("teal_modules-%s-data_summary-table", id)
  html <- output[[table_id]]$html
  as.data.frame(rvest::html_table(rvest::read_html(html), header = TRUE)[[1]])
}

is_slices_equivalent <<- function(x, y, with_attrs = TRUE) {
  x_list <- as.list(x, recursive = TRUE)
  y_list <- as.list(y, recursive = TRUE)
  attributes(x_list) <- NULL
  attributes(y_list) <- NULL
  if (with_attrs) {
    attributes(x_list) <- attributes(x)[c("mapping", "module_specific")]
    attributes(y_list) <- attributes(y)[c("mapping", "module_specific")]
  }
  identical(x_list, y_list)
}

transform_list <<- list(
  fail = teal_transform_module(
    ui = function(id) NULL,
    server = function(id, data) {
      moduleServer(id, function(input, output, session) {
        add_error <- reactiveVal(TRUE)
        observeEvent(input$add_error, add_error(input$add_error))

        reactive({
          if (add_error()) {
            stop("Oh no")
          } else {
            within(data(), iris <- head(iris, n = floor(nrow(iris) / 2)))
          }
        })
      })
    }
  ),
  iris = teal_transform_module(
    ui = function(id) NULL,
    server = function(id, data) {
      moduleServer(id, function(input, output, session) {
        n <- reactiveVal(6)
        observeEvent(input$n, n(input$n))

        reactive({
          within(data(), iris <- head(iris, n = n_input), n_input = n())
        })
      })
    }
  ),
  mtcars = teal_transform_module(
    ui = function(id) NULL,
    server = function(id, data) {
      moduleServer(id, function(input, output, session) {
        n <- reactiveVal(6)
        observeEvent(input$n, n(input$n))

        reactive({
          within(data(), mtcars <- head(mtcars, n = n_input), n_input = n())
        })
      })
    }
  )
)

testthat::describe("srv_teal arguments", {
  testthat::it("accepts data to be teal_data", {
    testthat::expect_no_error(
      shiny::testServer(
        app = srv_teal,
        args = list(
          id = "test",
          data = teal.data::teal_data(iris = iris),
          modules = modules(example_module())
        ),
        expr = NULL
      )
    )
  })

  testthat::it("accepts data to be teal_data_module returning reactive teal_data", {
    testthat::expect_no_error(
      shiny::testServer(
        app = srv_teal,
        args = list(
          id = "test",
          data = teal_data_module(ui = function(id) NULL, server = function(id) reactive(teal_data(iris = iris))),
          modules = modules(example_module())
        ),
        expr = NULL
      )
    )
  })

  testthat::it("accepts data to a reactive or reactiveVal teal_data", {
    testthat::expect_no_error(
      shiny::testServer(
        app = srv_teal,
        args = list(
          id = "test",
          data = reactive(teal_data(iris = iris)),
          modules = modules(example_module())
        ),
        expr = NULL
      )
    )

    reactive_val <- reactiveVal(teal_data(iris = iris))
    testthat::expect_no_error(
      shiny::testServer(
        app = srv_teal,
        args = list(
          id = "test",
          data = reactive_val,
          modules = modules(example_module())
        ),
        expr = NULL
      )
    )
  })

  testthat::it("fails when data is not teal_data or teal_data_module", {
    testthat::expect_error(
      shiny::testServer(
        app = srv_teal,
        args = list(
          id = "test",
          data = data.frame(),
          modules = modules(example_module())
        ),
        expr = NULL
      ),
      "Assertion on 'data' failed: Must inherit from class 'teal_data'/'teal_data_module'/'reactive', but has class 'data.frame'." # nolint: line_length
    )
  })

  testthat::it("app fails when teal_data_module doesn't return a reactive", {
    testthat::expect_error(
      shiny::testServer(
        app = srv_teal,
        args = list(
          id = "test",
          data = teal_data_module(ui = function(id) NULL, server = function(id) teal_data(iris = iris)),
          modules = modules(example_module())
        ),
        expr = {
          session$flushReact()
        }
      ),
      "Must be a reactive"
    )
  })
})

testthat::describe("srv_teal teal_modules", {
  testthat::it("are not called by default", {
    shiny::testServer(
      app = srv_teal,
      args = list(
        id = "test",
        data = reactive(teal_data(iris = iris)),
        modules = modules(
          module("module_1", server = function(id, data) 101L),
          module("module_2", server = function(id, data) 102L)
        )
      ),
      expr = {
        testthat::expect_null(modules_output$module_1())
        testthat::expect_null(modules_output$module_2())
      }
    )
  })

  testthat::it("are called once their tab is selected and data is `teal_data`", {
    shiny::testServer(
      app = srv_teal,
      args = list(
        id = "test",
        data = teal_data(iris = iris),
        modules = modules(
          module("module_1", server = function(id, data) 101L),
          module("module_2", server = function(id, data) 102L)
        )
      ),
      expr = {
        session$setInputs(`teal_modules-active_tab` = "module_1")
        testthat::expect_identical(modules_output$module_1(), 101L)
        testthat::expect_null(modules_output$module_2())
        session$setInputs(`teal_modules-active_tab` = "module_2")
        testthat::expect_identical(modules_output$module_1(), 101L)
        testthat::expect_identical(modules_output$module_2(), 102L)
      }
    )
  })

  testthat::it("are called once their tab is selected and data returns reactive `teal_data`", {
    shiny::testServer(
      app = srv_teal,
      args = list(
        id = "test",
        data = reactive(teal_data(iris = iris)),
        modules = modules(
          module("module_1", server = function(id, data) 101L),
          module("module_2", server = function(id, data) 102L)
        )
      ),
      expr = {
        session$setInputs(`teal_modules-active_tab` = "module_1")
        testthat::expect_identical(modules_output$module_1(), 101L)
        testthat::expect_null(modules_output$module_2())

        session$setInputs(`teal_modules-active_tab` = "module_2")
        testthat::expect_identical(modules_output$module_1(), 101L)
        testthat::expect_identical(modules_output$module_2(), 102L)
      }
    )
  })

  testthat::it("are called once their tab is selected and teal_data_module returns reactive `teal_data`", {
    shiny::testServer(
      app = srv_teal,
      args = list(
        id = "test",
        data = teal_data_module(
          ui = function(id) NULL,
          server = function(id) {
            moduleServer(id, function(input, output, session) {
              reactive(teal_data(iris = iris))
            })
          }
        ),
        modules = modules(
          module("module_1", server = function(id, data) 101L),
          module("module_2", server = function(id, data) 102L)
        )
      ),
      expr = {
        session$setInputs(`teal_modules-active_tab` = "module_1")
        testthat::expect_identical(modules_output$module_1(), 101L)
        testthat::expect_null(modules_output$module_2())

        session$setInputs(`teal_modules-active_tab` = "module_2")
        testthat::expect_identical(modules_output$module_1(), 101L)
        testthat::expect_identical(modules_output$module_2(), 102L)
      }
    )
  })

  testthat::it("are called only after teal_data_module is resolved", {
    shiny::testServer(
      app = srv_teal,
      args = list(
        id = "test",
        data = teal_data_module(
          ui = function(id) actionButton("submit", "click me"),
          server = function(id) {
            moduleServer(id, function(input, output, session) {
              eventReactive(input$submit, teal_data(iris = iris))
            })
          }
        ),
        modules = modules(
          module("module_1", server = function(id, data) 101L)
        )
      ),
      expr = {
        session$setInputs(`teal_modules-active_tab` = "module_1")
        session$flushReact()
        testthat::expect_null(modules_output$module_1())


        session$setInputs("data-teal_data_module-submit" = "1")
        session$flushReact()
        testthat::expect_identical(modules_output$module_1(), 101L)
      }
    )
  })

  testthat::it("are called with data argument being `teal_data`", {
    shiny::testServer(
      app = srv_teal,
      args = list(
        id = "test",
        data = teal_data(iris = iris),
        modules = modules(
          module("module_1", server = function(id, data) data)
        )
      ),
      expr = {
        session$setInputs(`teal_modules-active_tab` = "module_1")
        testthat::expect_s4_class(modules_output$module_1()(), "teal_data")
      }
    )
  })

  testthat::it("are not called when the teal_data_module doesn't return teal_data", {
    shiny::testServer(
      app = srv_teal,
      args = list(
        id = "test",
        data = teal_data_module(
          ui = function(id) NULL,
          server = function(id) {
            moduleServer(id, function(input, output, session) {
              reactive("my error")
            })
          }
        ),
        modules = modules(
          module("module_1", server = function(id, data) 101L),
          module("module_2", server = function(id, data) 102L)
        )
      ),
      expr = {
        testthat::expect_null(modules_output$module_1())
        session$setInputs(`teal_modules-active_tab` = "module_1")
        testthat::expect_null(modules_output$module_1())
      }
    )
  })

  testthat::it("are not called when teal_data_module returns validation error", {
    shiny::testServer(
      app = srv_teal,
      args = list(
        id = "test",
        data = teal_data_module(
          ui = function(id) NULL,
          server = function(id) {
            moduleServer(id, function(input, output, session) {
              reactive(validate(need(FALSE, "my error")))
            })
          }
        ),
        modules = modules(
          module("module_1", server = function(id, data) 101L),
          module("module_2", server = function(id, data) 102L)
        )
      ),
      expr = {
        testthat::expect_null(modules_output$module_1())
        testthat::expect_s3_class(data_handled(), "shiny.silent.error")
        session$setInputs(`teal_modules-active_tab` = "module_1")
        testthat::expect_null(modules_output$module_1())
      }
    )
  })

  testthat::it("are not called when teal_data_module throws an error", {
    shiny::testServer(
      app = srv_teal,
      args = list(
        id = "test",
        data = teal_data_module(
          ui = function(id) NULL,
          server = function(id) {
            moduleServer(id, function(input, output, session) {
              reactive(stop("my error"))
            })
          }
        ),
        modules = modules(
          module("module_1", server = function(id, data) 101L),
          module("module_2", server = function(id, data) 102L)
        )
      ),
      expr = {
        testthat::expect_null(modules_output$module_1())
        testthat::expect_s3_class(data_handled(), "simpleError")
        session$setInputs(`teal_modules-active_tab` = "module_1")
        testthat::expect_null(modules_output$module_1())
      }
    )
  })

  testthat::it("are not called when teal_data_module returns qenv.error", {
    shiny::testServer(
      app = srv_teal,
      args = list(
        id = "test",
        data = teal_data_module(
          ui = function(id) NULL,
          server = function(id) {
            moduleServer(id, function(input, output, session) {
              reactive(within(teal_data(), stop("my qenv error")))
            })
          }
        ),
        modules = modules(
          module("module_1", server = function(id, data) 101L),
          module("module_2", server = function(id, data) 102L)
        )
      ),
      expr = {
        testthat::expect_null(modules_output$module_1())
        testthat::expect_s3_class(data_handled(), "qenv.error")
        session$setInputs(`teal_modules-active_tab` = "module_1")
        testthat::expect_null(modules_output$module_1())
      }
    )
  })

  testthat::it("are receiving reactive data which triggers on change", {
    shiny::testServer(
      app = srv_teal,
      args = list(
        id = "test",
        data = teal_data_module(
          ui = function(id) NULL,
          server = function(id) {
            moduleServer(id, function(input, output, session) {
              eventReactive(input$dataset, {
                if (input$dataset == "iris") {
                  teal_data(iris = iris)
                } else if (input$dataset == "mtcars") {
                  teal_data(mtcars = mtcars)
                }
              })
            })
          }
        ),
        modules = modules(
          module("module_1", server = function(id, data) data),
          module("module_2", server = function(id, data) data)
        )
      ),
      expr = {
        testthat::expect_null(modules_output$module_1())
        session$setInputs(`data-teal_data_module-dataset` = "iris", `teal_modules-active_tab` = "module_1")
        testthat::expect_setequal(names(modules_output$module_1()()), "iris")
        session$setInputs(`data-teal_data_module-dataset` = "mtcars", `teal_modules-active_tab` = "module_2")
        testthat::expect_setequal(names(modules_output$module_2()()), "mtcars")
      }
    )
  })

  testthat::it("are not called again when data changes", {
    shiny::testServer(
      app = srv_teal,
      args = list(
        id = "test",
        data = teal_data_module(
          ui = function(id) NULL,
          server = function(id) {
            moduleServer(id, function(input, output, session) {
              eventReactive(input$dataset, {
                if (input$dataset == "iris") {
                  teal_data(iris = iris)
                } else if (input$dataset == "mtcars") {
                  teal_data(mtcars = mtcars)
                }
              })
            })
          }
        ),
        modules = modules(
          module("module_1", server = function(id, data) runif(1))
        )
      ),
      expr = {
        testthat::expect_null(modules_output$module_1())
        session$setInputs(
          `data-teal_data_module-dataset` = "iris",
          `teal_modules-active_tab` = "module_1"
        )
        out <- modules_output$module_1()
        testthat::expect_true(!is.null(out))
        session$setInputs(`data-teal_data_module-dataset` = "mtcars")
        testthat::expect_identical(out, modules_output$module_1())
      }
    )
  })

  testthat::it("receives data with datasets == module$datanames", {
    shiny::testServer(
      app = srv_teal,
      args = list(
        id = "test",
        data = reactive(teal_data(iris = iris, mtcars = mtcars)),
        modules = modules(
          module("module_1", server = function(id, data) data, datanames = c("iris"))
        )
      ),
      expr = {
        session$setInputs(`teal_modules-active_tab` = "module_1")
        testthat::expect_identical(names(modules_output$module_1()()), "iris")
        testthat::expect_identical(modules_output$module_1()()[["iris"]], iris)
      }
    )
  })

  testthat::describe("reserved dataname is being used:", {
    testthat::it("multiple datanames with `all` and `.raw_data`", {
      testthat::skip_if_not_installed("rvest")

      # Shared common code for tests
      td <- within(teal.data::teal_data(), {
        all <- mtcars
        iris <- iris
        .raw_data <- data.frame(
          Species = c("Setosa", "Virginica", "Versicolor"),
          New.Column = c("Setosas are cool", "Virginicas are also cool", "Versicolors are cool too")
        )
      })
      teal.data::join_keys(td) <- teal.data::join_keys(join_key(".raw_data", "iris", "Species"))

      shiny::testServer(
        app = srv_teal,
        args = list(
          id = "test",
          data = td,
          modules = modules(module("module_1", server = function(id, data) data))
        ),
        expr = {
          session$setInputs("teal_modules-active_tab" = "module_1")
          testthat::expect_equal(
            trimws(
              rvest::html_text2(
                rvest::read_html(
                  output[["teal_modules-module_1-validate_datanames-message"]]$html
                )
              )
            ),
            "all and .raw_data are reserved for internal use. Please avoid using them as dataset names."
          )
        }
      )
    })

    testthat::it("single dataname with `all`", {
      testthat::skip_if_not_installed("rvest")

      td <- within(teal.data::teal_data(), {
        all <- mtcars
        iris <- iris
      })

      shiny::testServer(
        app = srv_teal,
        args = list(
          id = "test",
          data = td,
          modules = modules(
            module("module_1", server = function(id, data) data)
          )
        ),
        expr = {
          session$setInputs("teal_modules-active_tab" = "module_1")
          session$flushReact()

          testthat::expect_equal(
            trimws(
              rvest::html_text2(
                rvest::read_html(
                  output[["teal_modules-module_1-validate_datanames-message"]]$html
                )
              )
            ),
            "all is reserved for internal use. Please avoid using it as a dataset name."
          )
        }
      )
    })
  })

  testthat::describe("warnings on missing datanames", {
    testthat::it("warns when dataname is not available", {
      testthat::skip_if_not_installed("rvest")
      shiny::testServer(
        app = srv_teal,
        args = list(
          id = "test",
          data = teal_data(iris = iris),
          modules = modules(
            module("module_1", server = function(id, data) data, datanames = c("iris", "missing"))
          )
        ),
        expr = {
          session$setInputs(`teal_modules-active_tab` = "module_1")
          testthat::expect_equal(
            trimws(
              rvest::html_text2(
                rvest::read_html(
                  output[["teal_modules-module_1-validate_datanames-message"]]$html
                )
              )
            ),
            "Dataset missing is missing. Dataset available in data: iris."
          )
        }
      )
    })

    testthat::it("warns when datanames are not available", {
      testthat::skip_if_not_installed("rvest")
      shiny::testServer(
        app = srv_teal,
        args = list(
          id = "test",
          data = teal_data(mtcars = mtcars, iris = iris),
          modules = modules(
            module("module_1", datanames = c("mtcars", "iris", "missing1", "missing2"))
          )
        ),
        expr = {
          session$setInputs(`teal_modules-active_tab` = "module_1")

          testthat::expect_equal(
            trimws(
              rvest::html_text2(
                rvest::read_html(
                  output[["teal_modules-module_1-validate_datanames-message"]]$html
                )
              )
            ),
            "Datasets missing1 and missing2 are missing. Datasets available in data: iris and mtcars."
          )
        }
      )
    })

    testthat::it("warns about empty data when none of module$datanames is available (even if data is not empty)", {
      testthat::skip_if_not_installed("rvest")
      shiny::testServer(
        app = srv_teal,
        args = list(
          id = "test",
          data = teal_data(mtcars = mtcars),
          modules = modules(
            module("module_1", datanames = c("missing1", "missing2"))
          )
        ),
        expr = {
          session$setInputs(`teal_modules-active_tab` = "module_1")
          testthat::expect_equal(
            trimws(
              rvest::html_text2(
                rvest::read_html(
                  output[["teal_modules-module_1-validate_datanames-message"]]$html
                )
              )
            ),
            "Datasets missing1 and missing2 are missing. No datasets are available in data."
          )
        }
      )
    })

    testthat::it("warns about empty data when none of module$datanames is available", {
      testthat::skip_if_not_installed("rvest")
      shiny::testServer(
        app = srv_teal,
        args = list(
          id = "test",
          data = reactive(teal_data(mtcars = mtcars)),
          modules = modules(
            module("module_1", datanames = c("missing1", "missing2"))
          )
        ),
        expr = {
          session$setInputs(`teal_modules-active_tab` = "module_1")
          testthat::expect_equal(
            trimws(
              rvest::html_text2(
                rvest::read_html(
                  output[["datanames_warning-message"]]$html
                )
              )
            ),
            "Datasets missing1 and missing2 are missing for module 'module_1'. Dataset available in data: mtcars."
          )
        }
      )
    })
  })

  testthat::it("is called and receives data even if datanames in `teal_data` are not sufficient", {
    data <- teal_data(iris = iris)
    shiny::testServer(
      app = srv_teal,
      args = list(
        id = "test",
        data = reactive(data),
        modules = modules(
          module("module_1", server = function(id, data) data, datanames = c("iris", "mtcars"))
        )
      ),
      expr = {
        session$setInputs(`teal_modules-active_tab` = "module_1")
        testthat::expect_identical(names(modules_output$module_1()()), "iris")
      }
    )
  })

  testthat::it("receives all objects from teal_data when module$datanames = \"all\"", {
    shiny::testServer(
      app = srv_teal,
      args = list(
        id = "test",
        data = reactive({
          td <- teal_data(iris = iris, mtcars = mtcars, swiss = swiss, iris_raw = iris)
          td
        }),
        modules = modules(
          module("module_1", server = function(id, data) data, datanames = "all")
        )
      ),
      expr = {
        session$setInputs(`teal_modules-active_tab` = "module_1")
        testthat::expect_identical(
          names(modules_output$module_1()()),
          c("iris", "iris_raw", "mtcars", "swiss")
        )
      }
    )
  })

  testthat::it("receives parent data when module$datanames limited to a child data but join keys are provided", {
    parent <- data.frame(id = 1:3, test = letters[1:3])
    child <- data.frame(id = 1:9, parent_id = rep(1:3, each = 3), test2 = letters[1:9])
    data <- teal_data(parent = parent, child = child)
    teal.data::join_keys(data) <- teal.data::join_keys(
      teal.data::join_key("parent", "child", c(id = "parent_id"))
    )

    shiny::testServer(
      app = srv_teal,
      args = list(
        id = "test",
        data = reactive(data),
        modules = modules(
          module("module_1", server = function(id, data) data, datanames = "child")
        )
      ),
      expr = {
        session$setInputs(`teal_modules-active_tab` = "module_1")
        testthat::expect_identical(modules_output$module_1()()[["parent"]], parent)
        testthat::expect_identical(modules_output$module_1()()[["child"]], child)
      }
    )
  })

  testthat::it("receives all transformator datasets if module$datanames == 'all'", {
    shiny::testServer(
      app = srv_teal,
      args = list(
        id = "test",
        data = reactive({
          td <- within(teal_data(), {
            iris <- iris
            mtcars <- mtcars
          })
          td
        }),
        modules = modules(
          module(
            label = "module_1",
            server = function(id, data) data,
            transformators = list(
              teal_transform_module(
                label = "Dummy",
                server = function(id, data) {
                  moduleServer(id, function(input, output, session) {
                    reactive(within(data(), swiss <- swiss))
                  })
                }
              )
            ),
            datanames = "all"
          )
        )
      ),
      expr = {
        session$setInputs(`teal_modules-active_tab` = "module_1")
        testthat::expect_identical(names(modules_output$module_1()()), c("iris", "mtcars", "swiss"))
      }
    )
  })

  testthat::it("receives all datasets if transform$datanames == 'all'", {
    shiny::testServer(
      app = srv_teal,
      args = list(
        id = "test",
        data = reactive({
          td <- within(teal_data(), {
            iris <- iris
            mtcars <- mtcars
          })
          td
        }),
        modules = modules(
          module(
            label = "module_1",
            server = function(id, data) data,
            transformators = list(
              teal_transform_module(
                label = "Dummy",
                server = function(id, data) {
                  moduleServer(id, function(input, output, session) {
                    reactive(within(data(), swiss <- swiss))
                  })
                }
              )
            ),
            datanames = "all"
          )
        )
      ),
      expr = {
        session$setInputs(`teal_modules-active_tab` = "module_1")
        testthat::expect_identical(names(modules_output$module_1()()), c("iris", "mtcars", "swiss"))
      }
    )
  })

  testthat::it("receives all raw datasets based on module$datanames", {
    shiny::testServer(
      app = srv_teal,
      args = list(
        id = "test",
        data = reactive({
          td <- within(teal_data(), {
            iris <- iris
            mtcars <- mtcars
            swiss <- swiss
          })
          td
        }),
        modules = modules(
          module(
            label = "module_1",
            server = function(id, data) data,
            datanames = c("iris", "swiss")
          )
        )
      ),
      expr = {
        session$setInputs(`teal_modules-active_tab` = "module_1")
        testthat::expect_setequal(names(modules_output$module_1()()[[".raw_data"]]), c("iris", "swiss"))
      }
    )
  })

  testthat::it("combines datanames from transform/module $datanames", {
    shiny::testServer(
      app = srv_teal,
      args = list(
        id = "test",
        data = reactive(teal_data(iris = iris, mtcars = mtcars, not_included = data.frame())),
        modules = modules(
          module(
            label = "module_1",
            server = function(id, data) data,
            transformators = list(
              teal_transform_module(
                label = "Dummy",
                ui = function(id) div("(does nothing)"),
                server = function(id, data) {
                  moduleServer(id, function(input, output, session) {
                    reactive(within(data(), swiss <- swiss))
                  })
                },
                datanames = "swiss"
              )
            ),
            datanames = c("iris", "mtcars")
          )
        )
      ),
      expr = {
        session$setInputs(`teal_modules-active_tab` = "module_1")
        testthat::expect_identical(names(modules_output$module_1()()), c("iris", "mtcars", "swiss"))
      }
    )
  })

  testthat::it("does not receive transformator datasets not specified in transform$datanames nor modue$datanames", {
    shiny::testServer(
      app = srv_teal,
      args = list(
        id = "test",
        data = reactive({
          td <- within(teal_data(), {
            iris <- iris
            mtcars <- mtcars
          })
          td
        }),
        modules = modules(
          module(
            label = "module_1",
            server = function(id, data) data,
            transformators = list(
              teal_transform_module(
                label = "Dummy",
                server = function(id, data) {
                  moduleServer(id, function(input, output, session) {
                    reactive(within(data(), swiss <- swiss))
                  })
                },
                datanames = character(0)
              )
            ),
            datanames = c("iris", "mtcars")
          )
        )
      ),
      expr = {
        session$setInputs(`teal_modules-active_tab` = "module_1")
        testthat::expect_identical(names(modules_output$module_1()()), c("iris", "mtcars"))
      }
    )
  })

  testthat::it("srv_teal_module.teal_module does not pass data if not in the args explicitly", {
    shiny::testServer(
      app = srv_teal,
      args = list(
        id = "test",
        data = teal.data::teal_data(iris = iris, mtcars = mtcars),
        modules = modules(
          module("module_1", server = function(id, ...) {
            list(...)$data
          })
        )
      ),
      expr = {
        session$setInputs(`teal_modules-active_tab` = "module_1")
        session$flushReact()
        testthat::expect_null(modules_output$module_1())
      }
    )
  })

  testthat::it("srv_teal_module.teal_module passes (deprecated) datasets to the server module", {
    testthat::expect_warning(
      shiny::testServer(
        app = srv_teal,
        args = list(
          id = "test",
          data = teal.data::teal_data(iris = iris, mtcars = mtcars),
          modules = modules(
            module("module_1", server = function(id, datasets) datasets)
          )
        ),
        expr = {
          session$setInputs(`teal_modules-active_tab` = "module_1")
          testthat::expect_s3_class(modules_output$module_1(), "FilteredData")
        }
      ),
      "`datasets` argument in the server is deprecated and will be removed in the next release"
    )
  })

  testthat::it("srv_teal_module.teal_module passes server_args to the ...", {
    shiny::testServer(
      app = srv_teal,
      args = list(
        id = "test",
        data = teal.data::teal_data(iris = iris, mtcars = mtcars),
        modules = modules(
          module(
            "module_1",
            server = function(id, data, ...) {
              data
            },
            server_args = list(x = 1L, y = 2L)
          )
        )
      ),
      expr = {
        session$setInputs(`teal_modules-active_tab` = "module_1")
        testthat::expect_identical(
          modules$children$module_1$server_args,
          list(x = 1L, y = 2L)
        )
      }
    )
  })

  testthat::it("srv_teal_module.teal_module passes quoted arguments to the teal_module$server call", {
    tm_query <- function(query) {
      module(
        "module_1",
        server = function(id, data, query) {
          moduleServer(id, function(input, output, session) {
            reactive(q <- eval_code(data(), query))
          })
        },
        server_args = list(query = query)
      )
    }
    shiny::testServer(
      app = srv_teal,
      args = list(
        id = "test",
        data = teal.data::teal_data(a_dataset = iris),
        modules = modules(tm_query(quote(a_dataset <- subset(a_dataset, Species == "setosa"))))
      ),
      expr = {
        session$setInputs(`teal_modules-active_tab` = "module_1")
        session$flushReact()

        testthat::expect_setequal(
          "setosa",
          unique(modules_output$module_1()()[["a_dataset"]]$Species)
        )
      }
    )
  })

  testthat::it("srv_teal_module.teal_module passes filter_panel_api if specified", {
    shiny::testServer(
      app = srv_teal,
      args = list(
        id = "test",
        data = teal.data::teal_data(iris = iris, mtcars = mtcars),
        modules = modules(
          module("module_1", server = function(id, filter_panel_api) filter_panel_api)
        )
      ),
      expr = {
        session$setInputs(`teal_modules-active_tab` = "module_1")
        testthat::expect_s3_class(modules_output$module_1(), "FilterPanelAPI")
      }
    )
  })

  testthat::it("srv_teal_module.teal_module passes Reporter if specified", {
    shiny::testServer(
      app = srv_teal,
      args = list(
        id = "test",
        data = teal.data::teal_data(iris = iris, mtcars = mtcars),
        modules = modules(
          module("module_1", server = function(id, reporter) reporter)
        )
      ),
      expr = {
        session$setInputs(`teal_modules-active_tab` = "module_1")
        testthat::expect_s3_class(modules_output$module_1(), "Reporter")
      }
    )
  })

  testthat::it("does not receive report_previewer when none of the modules contain reporter argument", {
    shiny::testServer(
      app = srv_teal,
      args = list(
        id = "test",
        data = teal.data::teal_data(iris = iris, mtcars = mtcars),
        modules = modules(
          module("module_1", server = function(id) {}),
          module("module_2", server = function(id) {})
        )
      ),
      expr = {
        session$setInputs(`teal_modules-active_tab` = "report_previewer")
        testthat::expect_setequal(names(modules_output), c("module_1", "module_2"))
      }
    )
  })

  testthat::it("receives one report_previewer module when any module contains reporter argument", {
    shiny::testServer(
      app = srv_teal,
      args = list(
        id = "test",
        data = teal.data::teal_data(iris = iris, mtcars = mtcars),
        modules = modules(
          module("module_1", server = function(id, reporter) {}),
          module("module_2", server = function(id) {})
        )
      ),
      expr = {
        session$setInputs(`teal_modules-active_tab` = "report_previewer")
        testthat::expect_setequal(names(modules_output), c("module_1", "module_2", "report_previewer"))
      }
    )
  })
})

testthat::describe("srv_teal filters", {
  testthat::describe("slicesGlobal", {
    testthat::it("is set to initial filters when !module_specific", {
      init_filter <- teal_slices(
        teal_slice("iris", "Species"),
        teal_slice("mtcars", "cyl"),
        mapping = list(
          global_filters = c("iris Species", "mtcars cyl")
        ),
        module_specific = FALSE
      )
      shiny::testServer(
        app = srv_teal,
        args = list(
          id = "test",
          data = teal.data::teal_data(iris = iris, mtcars = mtcars),
          modules = modules(example_module(label = "module-1"), example_module(label = "module-2")),
          filter = init_filter
        ),
        expr = {
          testthat::expect_identical(slices_global$all_slices(), init_filter)
        }
      )
    })
    testthat::it("is set to initial filters with resolved attr(, 'mapping')$<modules label> when `module_specific`", {
      init_filter <- teal_slices(
        teal_slice("iris", "Species"),
        teal_slice("mtcars", "cyl"),
        module_specific = TRUE,
        mapping = list(
          global_filters = c("iris Species", "mtcars cyl")
        )
      )
      shiny::testServer(
        app = srv_teal,
        args = list(
          id = "test",
          data = teal.data::teal_data(iris = iris, mtcars = mtcars),
          modules = modules(example_module(label = "module-1"), example_module(label = "module-2")),
          filter = init_filter
        ),
        expr = {
          setdiff_teal_slices <- getFromNamespace("setdiff_teal_slices", "teal.slice")
          testthat::expect_length(setdiff_teal_slices(slices_global$all_slices(), init_filter), 0)
          testthat::expect_identical(
            attr(slices_global$all_slices(), "mapping"),
            list(
              `module-1` = c("iris Species", "mtcars cyl"),
              `module-2` = c("iris Species", "mtcars cyl")
            )
          )
        }
      )
    })
    testthat::it("slices in slicesGlobal and in FilteredData refer to the same object", {
      init_filter <- teal_slices(
        teal_slice("iris", "Species"),
        teal_slice("mtcars", "cyl"),
        module_specific = TRUE,
        mapping = list(
          global_filters = c("iris Species", "mtcars cyl")
        )
      )
      shiny::testServer(
        app = srv_teal,
        args = list(
          id = "test",
          data = teal.data::teal_data(iris = iris, mtcars = mtcars),
          modules = modules(example_module(label = "module_1"), example_module(label = "module_2")),
          filter = init_filter
        ),
        expr = {
          session$setInputs(`teal_modules-active_tab` = "module_1")
          session$setInputs(`teal_modules-active_tab` = "module_2")
          testthat::expect_true(identical(
            slices_global$all_slices()[[1]],
            slices_global$module_slices_api[["module_1"]]$get_filter_state()[[1]]
          ))
          testthat::expect_true(identical(
            slices_global$all_slices()[[1]],
            slices_global$module_slices_api[["module_2"]]$get_filter_state()[[1]]
          ))
        }
      )
    })
    testthat::it("appends new slice and activates in $global_filters when added in a module if !module_specific", {
      shiny::testServer(
        app = srv_teal,
        args = list(
          id = "test",
          data = reactive(within(teal.data::teal_data(), {
            iris <- iris
            mtcars <- mtcars
          })),
          modules = modules(
            module("module_1", server = function(id, data) data),
            module("module_2", server = function(id, data) data)
          ),
          filter = teal_slices(module_specific = FALSE)
        ),
        expr = {
          session$setInputs(`teal_modules-active_tab` = "module_1")
          session$setInputs(`teal_modules-active_tab` = "module_2")
          session$setInputs(`teal_modules-module_2-filter_panel-filters-iris-iris-filter-var_to_add` = "Species")
          testthat::expect_true(is_slices_equivalent(
            x = slices_global$all_slices(),
            y = teal_slices(
              teal_slice("iris", "Species", choices = unique(iris$Species), selected = unique(iris$Species)),
              mapping = list(global_filters = "iris Species"),
              module_specific = FALSE
            )
          ))
        }
      )
    })
    testthat::it("deactivates in $global_filters when removed from module if !module_specific", {
      shiny::testServer(
        app = srv_teal,
        args = list(
          id = "test",
          data = reactive(within(teal.data::teal_data(), {
            iris <- iris
            mtcars <- mtcars
          })),
          modules = modules(
            module("module_1", server = function(id, data) data),
            module("module_2", server = function(id, data) data)
          ),
          filter = teal_slices(
            teal_slice("iris", varname = "Species", selected = "versicolor"),
            module_specific = FALSE
          )
        ),
        expr = {
          session$setInputs(`teal_modules-active_tab` = "module_1")
          session$setInputs(`teal_modules-active_tab` = "module_2")
          session$setInputs(`teal_modules-module_2-filter_panel-filters-iris-filter-iris_Species-remove` = "Species")
          testthat::expect_true(is_slices_equivalent(
            x = slices_global$all_slices(),
            y = teal_slices(
              teal_slice("iris", "Species", choices = unique(iris$Species), selected = "versicolor"),
              mapping = list(global_filters = character(0)),
              module_specific = FALSE
            )
          ))
        }
      )
    })
    testthat::it("appends new slice and activates in $<module> when added in a module if module_specific", {
      shiny::testServer(
        app = srv_teal,
        args = list(
          id = "test",
          data = reactive(within(teal.data::teal_data(), {
            iris <- iris
            mtcars <- mtcars
          })),
          modules = modules(
            module("module_1", server = function(id, data) data),
            module("module_2", server = function(id, data) data)
          ),
          filter = teal_slices(module_specific = TRUE)
        ),
        expr = {
          session$setInputs(`teal_modules-active_tab` = "module_1")
          session$setInputs(`teal_modules-active_tab` = "module_2")
          session$setInputs(`teal_modules-module_2-filter_panel-filters-iris-iris-filter-var_to_add` = "Species")
          testthat::expect_true(is_slices_equivalent(
            x = slices_global$all_slices(),
            y = teal_slices(
              teal_slice("iris", "Species", choices = unique(iris$Species), selected = unique(iris$Species)),
              mapping = list(module_1 = character(0), module_2 = "iris Species"),
              module_specific = TRUE
            )
          ))
        }
      )
    })
    testthat::it("appends added 'duplicated' slice and makes new-slice$id unique", {
      shiny::testServer(
        app = srv_teal,
        args = list(
          id = "test",
          data = reactive(within(teal.data::teal_data(), {
            iris <- iris
            mtcars <- mtcars
          })),
          modules = modules(
            module("module_1", server = function(id, data) data),
            module("module_2", server = function(id, data) data)
          ),
          filter = teal_slices(
            teal_slice("iris", "Species", choices = unique(iris$Species), selected = unique(iris$Species)),
            mapping = list(global_filters = character(0))
          )
        ),
        expr = {
          session$setInputs(`teal_modules-active_tab` = "module_1")
          session$setInputs(`teal_modules-module_1-filter_panel-filters-iris-iris-filter-var_to_add` = "Species")
          session$flushReact()
          testthat::expect_true(is_slices_equivalent(
            x = slices_global$all_slices(),
            y = teal_slices(
              teal_slice("iris", "Species", choices = unique(iris$Species), selected = unique(iris$Species)),
              teal_slice("iris", "Species",
                choices = unique(iris$Species), selected = unique(iris$Species),
                id = "iris Species_1"
              ),
              mapping = list(global_filters = "iris Species_1"),
              module_specific = FALSE
            )
          ))
        }
      )
    })
    testthat::it("deactivates in $<module> when removed from module if module_specific", {
      shiny::testServer(
        app = srv_teal,
        args = list(
          id = "test",
          data = reactive(within(teal.data::teal_data(), {
            iris <- iris
            mtcars <- mtcars
          })),
          modules = modules(
            module("module_1", server = function(id, data) data),
            module("module_2", server = function(id, data) data)
          ),
          filter = teal_slices(
            teal_slice("iris", varname = "Species", selected = "versicolor"),
            mapping = list(global_filters = "iris Species"),
            module_specific = TRUE
          )
        ),
        expr = {
          session$setInputs(`teal_modules-active_tab` = "module_1")
          session$setInputs(`teal_modules-active_tab` = "module_2")
          session$setInputs(`teal_modules-module_2-filter_panel-filters-iris-filter-iris_Species-remove` = "Species")
          testthat::expect_true(is_slices_equivalent(
            x = slices_global$all_slices(),
            y = teal_slices(
              teal_slice("iris", "Species", choices = unique(iris$Species), selected = "versicolor"),
              mapping = list(module_1 = "iris Species", module_2 = character(0)),
              module_specific = TRUE
            )
          ))
        }
      )
    })
    testthat::it("auto-resolves to mapping$<m> when setting slices with mapping$global_filters in module_specific ", {
      shiny::testServer(
        app = srv_teal,
        args = list(
          id = "test",
          data = reactive(within(teal.data::teal_data(), {
            iris <- iris
            mtcars <- mtcars
          })),
          modules = modules(
            module("module_1", server = function(id, data) data),
            module("module_2", server = function(id, data) data)
          ),
          filter = teal_slices(module_specific = TRUE)
        ),
        expr = {
          testthat::skip("need a fix in a .slicesGlobal")
          session$setInputs(`teal_modules-active_tab` = "module_1")
          session$setInputs(`teal_modules-active_tab` = "module_2")
          slices_global$slices_set(teal_slices(
            teal_slice("iris", "Species"),
            mapping = list(global_filters = "iris Species")
          ))
          testthat::expect_true(is_slices_equivalent(
            x = slices_global$all_slices(),
            y = teal_slices(
              teal_slice("iris", "Species", choices = unique(iris$Species), selected = unique(iris$Species)),
              mapping = list(module_1 = "iris Species", module_2 = "iris Species"),
              module_specific = TRUE
            )
          ))
        }
      )
    })
    testthat::it("sets filters from mapping$<mod> to all modules' FilteredData when !module_specific", {
      shiny::testServer(
        app = srv_teal,
        args = list(
          id = "test",
          data = reactive(within(teal.data::teal_data(), {
            iris <- iris
            mtcars <- mtcars
          })),
          modules = modules(
            module("module_1", server = function(id, data) data),
            module("module_2", server = function(id, data) data)
          ),
          filter = teal_slices(module_specific = FALSE)
        ),
        expr = {
          session$setInputs(`teal_modules-active_tab` = "module_1")
          session$setInputs(`teal_modules-active_tab` = "module_2")
          slices_global$slices_append(teal_slices(teal_slice("iris", "Species", selected = "versicolor")))
          slices_global$slices_active(list(global_filter = "iris Species"))
          session$flushReact()
          expected_slices <- slices_global$all_slices()

          testthat::expect_true(is_slices_equivalent(
            x = slices_global$all_slices(),
            y = slices_global$module_slices_api[["global_filters"]]$get_filter_state(),
            with_attrs = FALSE
          ))
        }
      )
    })
    testthat::it("sets filters from mapping$<mod> to module's FilteredData when module_specific", {
      shiny::testServer(
        app = srv_teal,
        args = list(
          id = "test",
          data = reactive(within(teal.data::teal_data(), {
            iris <- iris
            mtcars <- mtcars
          })),
          modules = modules(
            module("module_1", server = function(id, data) data),
            module("module_2", server = function(id, data) data)
          ),
          filter = teal_slices(module_specific = TRUE)
        ),
        expr = {
          session$setInputs(`teal_modules-active_tab` = "module_1")
          session$setInputs(`teal_modules-active_tab` = "module_2")
          slices_global$slices_append(teal_slices(teal_slice("iris", "Species", selected = "versicolor")))
          slices_global$slices_active(list(module_1 = "iris Species"))
          session$flushReact()
          expected_slices <- slices_global$all_slices()
          testthat::expect_true(is_slices_equivalent(
            x = slices_global$all_slices(),
            y = slices_global$module_slices_api[["module_1"]]$get_filter_state(),
            with_attrs = FALSE
          ))
          testthat::expect_true(is_slices_equivalent(
            x = teal_slices(),
            y = slices_global$module_slices_api[["module_2"]]$get_filter_state(),
            with_attrs = FALSE
          ))
        }
      )
    })
    testthat::it("sets filters from mapping$global_filters to all modules' FilteredData when module_specific", {
      shiny::testServer(
        app = srv_teal,
        args = list(
          id = "test",
          data = reactive(within(teal.data::teal_data(), {
            iris <- iris
            mtcars <- mtcars
          })),
          modules = modules(
            module("module_1", server = function(id, data) data),
            module("module_2", server = function(id, data) data)
          ),
          filter = teal_slices(module_specific = TRUE)
        ),
        expr = {
          session$setInputs(`teal_modules-active_tab` = "module_1")
          session$setInputs(`teal_modules-active_tab` = "module_2")
          slices_global$slices_append(teal_slices(teal_slice("iris", "Species", selected = "versicolor")))
          slices_global$slices_active(list(global_filters = "iris Species"))
          session$flushReact()
          expected_slices <- slices_global$all_slices()
          testthat::expect_true(is_slices_equivalent(
            x = slices_global$all_slices(),
            y = slices_global$module_slices_api[["module_1"]]$get_filter_state(),
            with_attrs = FALSE
          ))
          testthat::expect_true(is_slices_equivalent(
            x = slices_global$all_slices(),
            y = slices_global$module_slices_api[["module_2"]]$get_filter_state(),
            with_attrs = FALSE
          ))
        }
      )
    })
    testthat::it("change in the slicesGlobal causes module's data filtering", {
      existing_filters <- teal_slices(
        teal_slice(dataname = "iris", varname = "Species", selected = "versicolor"),
        teal_slice(dataname = "mtcars", varname = "cyl", selected = 6)
      )
      shiny::testServer(
        app = srv_teal,
        args = list(
          id = "test",
          data = reactive(within(teal.data::teal_data(), {
            iris <- iris
            mtcars <- mtcars
          })),
          filter = existing_filters,
          modules = modules(module("module_1", server = function(id, data) data))
        ),
        expr = {
          session$setInputs(`teal_modules-active_tab` = "module_1")
          slices_global$slices_set(
            teal_slices(
              teal_slice("mtcars", varname = "cyl", selected = "4")
            )
          )
          session$flushReact()
          # iris is not active
          testthat::expect_identical(modules_output$module_1()()[["iris"]], iris)
          # mtcars has been modified
          expected_mtcars <- subset(mtcars, cyl == 4)
          testthat::expect_identical(modules_output$module_1()()[["mtcars"]], expected_mtcars)
          expected_code <- paste0(
            c(
              "iris <- iris",
              "mtcars <- mtcars",
              sprintf('stopifnot(rlang::hash(iris) == "%s") # @linksto iris', rlang::hash(iris)),
              sprintf('stopifnot(rlang::hash(mtcars) == "%s") # @linksto mtcars', rlang::hash(mtcars)),
              ".raw_data <- list2env(list(iris = iris, mtcars = mtcars))",
              "lockEnvironment(.raw_data) # @linksto .raw_data",
              "mtcars <- dplyr::filter(mtcars, cyl == 4)"
            ),
            collapse = "\n"
          )
          testthat::expect_identical(teal.code::get_code(modules_output$module_1()()), expected_code)
        }
      )
    })
  })

  testthat::describe("mapping table", {
    testthat::it("returns no rows if no filters set", {
      shiny::testServer(
        app = srv_teal,
        args = list(
          id = "test",
          data = teal.data::teal_data(iris = iris, mtcars = mtcars),
          modules = modules(module("module_1", server = function(id, data) data))
        ),
        expr = {
          session$setInputs("teal_modules-active_tab" = "module_1")
          session$flushReact()
          testthat::expect_equal(
            mapping_table(),
            data.frame(
              `Global filters` = logical(0),
              row.names = integer(0),
              check.names = FALSE
            )
          )
        }
      )
    })
    testthat::it("returns global filters with active=true, inactive=false, unavailable=na", {
      shiny::testServer(
        app = srv_teal,
        args = list(
          id = "test",
          data = teal.data::teal_data(iris = iris, mtcars = mtcars),
          modules = modules(
            module("module_1", server = function(id, data) data),
            module("module_2", server = function(id, data) data)
          ),
          filter = teal_slices(
            teal_slice("iris", "Species"),
            teal_slice("mtcars", "cyl"),
            teal_slice("unknown", "unavailable"),
            mapping = list(global_filters = "iris Species")
          )
        ),
        expr = {
          testthat::expect_warning(
            session$setInputs("teal_modules-active_tab" = "module_1"),
            "Filter 'unknown unavailable' refers to dataname not available in 'data'"
          )
          session$flushReact()
          testthat::expect_identical(
            mapping_table(),
            data.frame(
              `Global filters` = c(TRUE, FALSE, NA),
              row.names = c("iris Species", "mtcars cyl", "unknown unavailable"),
              check.names = FALSE
            )
          )
        }
      )
    })

    testthat::it("returns column per module with active=true, inactive=false, unavailable=na", {
      shiny::testServer(
        app = srv_teal,
        args = list(
          id = "test",
          data = teal.data::teal_data(iris = iris, mtcars = mtcars),
          modules = modules(
            module("module_1", server = function(id, data) data),
            module("module_2", server = function(id, data) data)
          ),
          filter = teal_slices(
            teal_slice("iris", "Species"),
            teal_slice("mtcars", "cyl"),
            teal_slice("unknown", "unavailable"),
            module_specific = TRUE,
            mapping = list(module_1 = "iris Species", module_2 = "mtcars cyl")
          )
        ),
        expr = {
          testthat::expect_warning(
            session$setInputs("teal_modules-active_tab" = "module_1"),
            "Filter 'unknown unavailable' refers to dataname not available in 'data'"
          )
          session$flushReact()
          testthat::expect_identical(
            mapping_table(),
            data.frame(
              module_1 = c(TRUE, FALSE, NA),
              module_2 = c(FALSE, TRUE, NA),
              row.names = c("iris Species", "mtcars cyl", "unknown unavailable"),
              check.names = FALSE
            )
          )
        }
      )
    })

    testthat::it("what happens when module$label is duplicated (when nested modules)", {
      testthat::skip("todo")
    })
  })
})

testthat::describe("srv_teal data reload", {
  testthat::it("sets back the same active filters in each module", {
    testthat::skip("todo")
  })
  testthat::it("doesn't fail when teal_data has no datasets", {
    testthat::skip("todo")
  })
})

testthat::describe("srv_teal teal_module(s) transformator", {
  testthat::it("evaluates custom qenv call and pass updated teal_data to the module", {
    shiny::testServer(
      app = srv_teal,
      args = list(
        id = "test",
        data = teal.data::teal_data(iris = iris, mtcars = mtcars),
        modules = modules(
          module(
            label = "module_1",
            server = function(id, data) data,
            transformators = transform_list[c("iris", "mtcars")]
          )
        )
      ),
      expr = {
        session$setInputs(`teal_modules-active_tab` = "module_1")
        testthat::expect_identical(modules_output$module_1()()[["iris"]], head(iris))
        testthat::expect_identical(modules_output$module_1()()[["mtcars"]], head(mtcars))
      }
    )
  })

  testthat::it("evaluates custom qenv call after filter is applied", {
    shiny::testServer(
      app = srv_teal,
      args = list(
        id = "test",
        data = reactive(within(teal.data::teal_data(), {
          iris <- iris
          mtcars <- mtcars
        })),
        filter = teal_slices(
          teal_slice(dataname = "iris", varname = "Species", selected = "versicolor"),
          teal_slice(dataname = "mtcars", varname = "cyl", selected = 6)
        ),
        modules = modules(
          module(
            label = "module_1",
            server = function(id, data) data,
            transformators = transform_list[c("iris", "mtcars")]
          )
        )
      ),
      expr = {
        session$setInputs(`teal_modules-active_tab` = "module_1")
        expected_iris <- subset(iris, Species == "versicolor")
        rownames(expected_iris) <- NULL
        expected_iris <- head(expected_iris)
        testthat::expect_identical(modules_output$module_1()()[["iris"]], expected_iris)
        testthat::expect_identical(modules_output$module_1()()[["mtcars"]], head(subset(mtcars, cyl == 6)))
        expected_code <- paste(collapse = "\n", c(
          "iris <- iris",
          "mtcars <- mtcars",
          sprintf('stopifnot(rlang::hash(iris) == "%s") # @linksto iris', rlang::hash(iris)),
          sprintf('stopifnot(rlang::hash(mtcars) == "%s") # @linksto mtcars', rlang::hash(mtcars)),
          ".raw_data <- list2env(list(iris = iris, mtcars = mtcars))",
          "lockEnvironment(.raw_data) # @linksto .raw_data",
          'iris <- dplyr::filter(iris, Species == "versicolor")',
          "mtcars <- dplyr::filter(mtcars, cyl == 6)",
          "iris <- head(iris, n = 6)",
          "mtcars <- head(mtcars, n = 6)"
        ))
        testthat::expect_identical(
          teal.code::get_code(modules_output$module_1()()),
          expected_code
        )
      }
    )
  })

  testthat::it("is reactive to the filter changes", {
    shiny::testServer(
      app = srv_teal,
      args = list(
        id = "test",
        data = reactive(within(teal.data::teal_data(), {
          iris <- iris
          mtcars <- mtcars
        })),
        modules = modules(
          module(
            label = "module_1",
            server = function(id, data) data,
            transformators = transform_list[c("iris", "mtcars")]
          )
        )
      ),
      expr = {
        session$setInputs(`teal_modules-active_tab` = "module_1")
        slices_global$slices_set(
          teal_slices(teal_slice(dataname = "mtcars", varname = "cyl", selected = "4"))
        )
        session$flushReact()

        testthat::expect_identical(modules_output$module_1()()[["iris"]], head(iris))
        testthat::expect_identical(modules_output$module_1()()[["mtcars"]], head(subset(mtcars, cyl == 4)))
        expected_code <- paste(collapse = "\n", c(
          "iris <- iris",
          "mtcars <- mtcars",
          sprintf('stopifnot(rlang::hash(iris) == "%s") # @linksto iris', rlang::hash(iris)),
          sprintf('stopifnot(rlang::hash(mtcars) == "%s") # @linksto mtcars', rlang::hash(mtcars)),
          ".raw_data <- list2env(list(iris = iris, mtcars = mtcars))",
          "lockEnvironment(.raw_data) # @linksto .raw_data",
          "mtcars <- dplyr::filter(mtcars, cyl == 4)",
          "iris <- head(iris, n = 6)",
          "mtcars <- head(mtcars, n = 6)"
        ))
        testthat::expect_identical(
          teal.code::get_code(modules_output$module_1()()),
          expected_code
        )
      }
    )
  })

  testthat::it("receives all possible objects while those not specified in module$datanames are unfiltered", {
    shiny::testServer(
      app = srv_teal,
      args = list(
        id = "test",
        data = reactive(within(teal.data::teal_data(), {
          iris <- iris
          mtcars <- mtcars
        })),
        filter = teal_slices(
          teal_slice(dataname = "mtcars", varname = "cyl", selected = "4"),
          teal_slice(dataname = "iris", varname = "Species", selected = "versicolor")
        ),
        modules = modules(
          module(
            label = "module_1",
            server = function(id, data) data,
            datanames = c("iris", "data_from_transform"),
            transformators = list(
              teal_transform_module(
                ui = function(id) NULL,
                server = function(id, data) {
                  moduleServer(id, function(input, output, session) {
                    reactive({
                      within(data(), data_from_transform <- list(iris = iris, mtcars = mtcars))
                    })
                  })
                },
                datanames = character(0)
              )
            )
          )
        )
      ),
      expr = {
        session$setInputs(`teal_modules-active_tab` = "module_1")
        data_from_transform <- modules_output$module_1()()[["data_from_transform"]]
        testthat::expect_identical(data_from_transform$mtcars, mtcars)
        expected_iris <- iris[iris$Species == "versicolor", ]
        rownames(expected_iris) <- NULL
        testthat::expect_identical(data_from_transform$iris, expected_iris)
      }
    )
  })

  testthat::it("throws a warning when transformator returns reactive.event", {
    testthat::expect_warning(
      testServer(
        app = srv_teal,
        args = list(
          id = "test",
          data = teal.data::teal_data(iris = iris),
          modules = modules(
            module(
              server = function(id, data) data,
              transformators = list(
                teal_transform_module(
                  ui = function(id) textInput("a", "an input"),
                  server = function(id, data) eventReactive(input$a, data())
                )
              )
            )
          )
        ),
        expr = {
          session$setInputs("teal_modules-active_tab" = "module")
          session$flushReact()
        }
      ),
      "Using eventReactive in teal_transform module server code should be avoided"
    )
  })

  testthat::it("fails when transformator doesn't return reactive", {
    testthat::expect_warning(
      # error decorator is mocked to avoid showing the trace error during the
      # test.
      # This tests works without the mocking, but it's more verbose.
      testthat::with_mocked_bindings(
        testServer(
          app = srv_teal,
          args = list(
            id = "test",
            data = teal.data::teal_data(iris = iris),
            modules = modules(
              module(
                server = function(id, data) data,
                transformators = list(
                  teal_transform_module(
                    ui = function(id) NULL,
                    server = function(id, data) "whatever"
                  )
                )
              )
            )
          ),
          expr = {
            session$setInputs("teal_modules-active_tab" = "module")
            session$flushReact()
          }
        ),
        decorate_err_msg = function(x, ...) {
          testthat::expect_error(x, "Must be a reactive")
          warning(tryCatch(x, error = function(e) e$message))
        },
      ),
      "Must be a reactive"
    )
  })

  testthat::it("pauses when transformator throws validation error", {
    shiny::testServer(
      app = srv_teal,
      args = list(
        id = "test",
        data = teal.data::teal_data(iris = iris),
        modules = modules(
          module(
            label = "module_1",
            server = function(id, data) data,
            transformators = list(
              teal_transform_module(
                ui = function(id) NULL,
                server = function(id, data) {
                  reactive(validate(need(FALSE, "my error")))
                }
              )
            )
          )
        )
      ),
      expr = {
        session$setInputs(`teal_modules-active_tab` = "module_1")
        testthat::expect_null(modules_output$module_1())
      }
    )
  })

  testthat::it("pauses when transformator throws validation error", {
    shiny::testServer(
      app = srv_teal,
      args = list(
        id = "test",
        data = teal.data::teal_data(iris = iris),
        modules = modules(
          module(
            label = "module_1",
            server = function(id, data) data,
            transformators = list(
              teal_transform_module(
                ui = function(id) NULL,
                server = function(id, data) {
                  reactive(validate(need(FALSE, "my error")))
                }
              )
            )
          )
        )
      ),
      expr = {
        session$setInputs(`teal_modules-active_tab` = "module_1")
        testthat::expect_null(modules_output$module_1())
      }
    )
  })

  testthat::it("pauses when transformator throws qenv error", {
    shiny::testServer(
      app = srv_teal,
      args = list(
        id = "test",
        data = teal.data::teal_data(iris = iris),
        modules = modules(
          module(
            label = "module_1",
            server = function(id, data) data,
            transformators = list(
              teal_transform_module(
                ui = function(id) NULL,
                server = function(id, data) {
                  reactive(within(data(), stop("my error")))
                }
              )
            )
          )
        )
      ),
      expr = {
        session$setInputs(`teal_modules-active_tab` = "module_1")
        testthat::expect_null(modules_output$module_1())
      }
    )
  })

  testthat::it("isn't called when `data` is not teal_data", {
    shiny::testServer(
      app = srv_teal,
      args = list(
        id = "test",
        data = teal.data::teal_data(iris = iris),
        modules = modules(
          module(
            label = "module_1",
            server = function(id, data) data,
            transformators = list(
              teal_transform_module(
                ui = function(id) NULL,
                server = function(id, data) {
                  reactive(data.frame())
                }
              )
            )
          )
        )
      ),
      expr = {
        session$setInputs(`teal_modules-active_tab` = "module_1")
        testthat::expect_null(modules_output$module_1())
      }
    )
  })

  testthat::it("changes module output for a module with a static decorator", {
    output_decorator <- teal_transform_module(
      label = "output_decorator",
      server = make_teal_transform_server(expression(object <- rev(object)))
    )

    shiny::testServer(
      app = srv_teal,
      args = list(
        id = "test",
        data = teal.data::teal_data(object = iris),
        modules = modules(example_module("mod1", decorators = list(output_decorator)))
      ),
      expr = {
        session$setInputs(`teal_modules-active_tab` = "mod1")
        session$setInputs(`teal_modules-mod1-module-dataname` = "object")
        session$flushReact()
        testthat::expect_identical(
          modules_output$mod1()()[["object"]],
          rev(iris)
        )
      }
    )
  })


  testthat::it("changes module output for a module with a decorator that is a function of an object name", {
    decorator_name <- function(output_name, label) {
      teal_transform_module(
        label = label,
        server = function(id, data) {
          moduleServer(id, function(input, output, session) {
            reactive({
              within(
                data(),
                output_name <- paste0(output_name, " lorem ipsum"),
                text = input$text,
                output_name = as.name(output_name)
              )
            })
          })
        }
      )
    }

    shiny::testServer(
      app = srv_teal,
      args = list(
        id = "test",
        data = teal.data::teal_data(x1 = "ABC"),
        modules = modules(
          example_module(
            "mod1",
            decorators = list(decorator_name(output_name = "object", label = "decorator_name"))
          )
        )
      ),
      expr = {
        session$setInputs(`teal_modules-active_tab` = "mod1")
        session$setInputs(`teal_modules-mod1-module-dataname` = "x1")
        session$flushReact()

        testthat::expect_identical(modules_output$mod1()()[["object"]], "ABC lorem ipsum")
      }
    )
  })

  testthat::it("changes module output for a module with an interactive decorator", {
    decorator_name <- function(output_name, label) {
      teal_transform_module(
        label = label,
        server = function(id, data) {
          moduleServer(id, function(input, output, session) {
            reactive({
              req(data(), input$text)
              within(
                data(),
                output_name <- paste0(output_name, " ", text),
                text = input$text,
                output_name = as.name(output_name)
              )
            })
          })
        }
      )
    }

    shiny::testServer(
      app = srv_teal,
      args = list(
        id = "test",
        data = teal.data::teal_data(x1 = "ABC"),
        modules = modules(
          example_module(
            "mod1",
            decorators = list(decorator_name(output_name = "object", label = "decorator_name"))
          )
        )
      ),
      expr = {
        session$setInputs(`teal_modules-active_tab` = "mod1")
        session$setInputs(`teal_modules-mod1-module-dataname` = "x1")
        session$setInputs(`teal_modules-mod1-module-decorate-transform_1-transform-text` = "lorem ipsum dolor")
        session$flushReact()

        testthat::expect_identical(modules_output$mod1()()[["object"]], "ABC lorem ipsum dolor")
      }
    )
  })
})

testthat::describe("srv_teal summary table", {
  testthat::it("displays Obs only column if all datasets have no join keys", {
    shiny::testServer(
      app = srv_teal,
      args = list(
        id = "test",
        data = reactive(within(teal.data::teal_data(), {
          iris <- iris
          mtcars <- mtcars
        })),
        modules = modules(module("module_1", server = function(id, data) data))
      ),
      expr = {
        session$setInputs("teal_modules-active_tab" = "module_1")
        testthat::expect_identical(
          module_summary_table(output, "module_1"),
          data.frame(
            "Data Name" = c("iris", "mtcars"),
            Obs = c("150/150", "32/32"),
            check.names = FALSE
          )
        )
      }
    )
  })

  testthat::it("displays Subjects with count based on foreign key column", {
    data <- teal.data::teal_data(
      a = data.frame(id = seq(3), name = letters[seq(3)]),
      b = data.frame(id = rep(seq(3), 2), id2 = seq(6), value = letters[seq(6)])
    )
    teal.data::join_keys(data) <- teal.data::join_keys(
      teal.data::join_key("a", "b", keys = "id")
    )

    shiny::testServer(
      app = srv_teal,
      args = list(
        id = "test",
        data = data,
        modules = modules(module("module_1", server = function(id, data) data))
      ),
      expr = {
        session$setInputs("teal_modules-active_tab" = "module_1")
        testthat::expect_identical(
          module_summary_table(output, "module_1"),
          data.frame(
            "Data Name" = c("a", "b"),
            Obs = c("3/3", "6/6"),
            Subjects = c("", "3/3"),
            check.names = FALSE
          )
        )
      }
    )
  })

  testthat::it("displays parent's Subjects with count based on primary key", {
    data <- teal.data::teal_data(
      a = data.frame(id = seq(3), name = letters[seq(3)]),
      b = data.frame(id = rep(seq(3), 2), id2 = seq(6), value = letters[seq(6)])
    )
    teal.data::join_keys(data) <- teal.data::join_keys(
      teal.data::join_key("a", keys = "id"),
      teal.data::join_key("b", keys = c("id", "id2"))
    )

    shiny::testServer(
      app = srv_teal,
      args = list(
        id = "test",
        data = data,
        modules = modules(module("module_1", server = function(id, data) data))
      ),
      expr = {
        session$setInputs("teal_modules-active_tab" = "module_1")
        testthat::expect_identical(
          module_summary_table(output, "module_1"),
          data.frame(
            "Data Name" = c("a", "b"),
            Obs = c("3/3", "6/6"),
            Subjects = c("3/3", "6/6"),
            check.names = FALSE
          )
        )
      }
    )
  })

  testthat::it("displays parent's Subjects with count based on primary and foreign key", {
    data <- teal.data::teal_data(
      a = data.frame(id = seq(3), name = letters[seq(3)]),
      b = data.frame(id = rep(seq(3), 2), id2 = seq(6), value = letters[seq(6)])
    )
    teal.data::join_keys(data) <- teal.data::join_keys(
      teal.data::join_key("a", keys = "id"),
      teal.data::join_key("b", keys = c("id", "id2")),
      teal.data::join_key("a", "b", keys = "id")
    )

    shiny::testServer(
      app = srv_teal,
      args = list(
        id = "test",
        data = data,
        modules = modules(module("module_1", server = function(id, data) data))
      ),
      expr = {
        session$setInputs("teal_modules-active_tab" = "module_1")
        testthat::expect_identical(
          module_summary_table(output, "module_1"),
          data.frame(
            "Data Name" = c("a", "b"),
            Obs = c("3/3", "6/6"),
            Subjects = c("3/3", "3/3"),
            check.names = FALSE
          )
        )
      }
    )
  })

  testthat::it("reflects filters and displays subjects by their unique id count", {
    data <- teal.data::teal_data(
      a = data.frame(id = seq(3), name = letters[seq(3)]),
      b = data.frame(id = rep(seq(3), 2), id2 = seq(6), value = letters[seq(6)])
    )
    teal.data::join_keys(data) <- teal.data::join_keys(
      teal.data::join_key("a", keys = "id"),
      teal.data::join_key("b", keys = c("id", "id2")),
      teal.data::join_key("a", "b", keys = "id")
    )

    shiny::testServer(
      app = srv_teal,
      args = list(
        id = "test",
        data = data,
        modules = modules(module("module_1", server = function(id, data) data)),
        filter = teal_slices(teal_slice("a", "name", selected = "a"))
      ),
      expr = {
        session$setInputs("teal_modules-active_tab" = "module_1")
        testthat::expect_identical(
          module_summary_table(output, "module_1"),
          data.frame(
            "Data Name" = c("a", "b"),
            Obs = c("1/3", "2/6"),
            Subjects = c("1/3", "1/3"),
            check.names = FALSE
          )
        )
      }
    )
  })

  testthat::it("reflects added filters and displays subjects by their unique id count", {
    data <- teal.data::teal_data(
      a = data.frame(id = seq(3), name = letters[seq(3)]),
      b = data.frame(id = rep(seq(3), 2), id2 = seq(6), value = letters[seq(6)])
    )
    teal.data::join_keys(data) <- teal.data::join_keys(
      teal.data::join_key("a", keys = "id"),
      teal.data::join_key("b", keys = c("id", "id2")),
      teal.data::join_key("a", "b", keys = "id")
    )

    shiny::testServer(
      app = srv_teal,
      args = list(
        id = "test",
        data = data,
        modules = modules(module("module_1", server = function(id, data) data))
      ),
      expr = {
        session$setInputs("teal_modules-active_tab" = "module_1")
        slices_global$slices_set(teal_slices(teal_slice("a", "name", selected = "a")))
        session$flushReact()
        testthat::expect_identical(
          module_summary_table(output, "module_1"),
          data.frame(
            "Data Name" = c("a", "b"),
            Obs = c("1/3", "2/6"),
            Subjects = c("1/3", "1/3"),
            check.names = FALSE
          )
        )
      }
    )
  })

  testthat::it("reflects transformator adding new dataset if specified in module", {
    shiny::testServer(
      app = srv_teal,
      args = list(
        id = "test",
        data = teal.data::teal_data(iris = iris),
        modules = modules(
          module(
            "module_1",
            server = function(id, data) data,
            transformators = teal_transform_module(
              datanames = character(0),
              server = function(id, data) {
                moduleServer(id, function(input, output, session) {
                  reactive({
                    within(data(), new_dataset <- data.frame(x = 1:3))
                  })
                })
              }
            ),
            datanames = c("iris", "new_dataset")
          )
        )
      ),
      expr = {
        session$setInputs("teal_modules-active_tab" = "module_1")
        testthat::expect_identical(
          module_summary_table(output, "module_1"),
          data.frame(
            "Data Name" = c("iris", "new_dataset"),
            Obs = c("150/150", "3"),
            check.names = FALSE
          )
        )
      }
    )
  })

  testthat::it("reflects transformator filtering", {
    testthat::it("displays parent's Subjects with count based on primary key", {
      shiny::testServer(
        app = srv_teal,
        args = list(
          id = "test",
          data = teal.data::teal_data(iris = iris),
          modules = modules(
            module(
              "module_1",
              server = function(id, data) data,
              transformators = transform_list["iris"]
            )
          )
        ),
        expr = {
          session$setInputs("teal_modules-active_tab" = "module_1")
          testthat::expect_identical(
            module_summary_table(output, "module_1"),
            data.frame(
              "Data Name" = c("iris"),
              Obs = c("6/150"),
              check.names = FALSE
            )
          )
        }
      )
    })
  })

  testthat::it("displays only module$datanames", {
    data <- teal.data::teal_data(iris = iris, mtcars = mtcars)
    shiny::testServer(
      app = srv_teal,
      args = list(
        id = "test",
        data = data,
        modules = modules(module("module_1", server = function(id, data) data, datanames = "iris"))
      ),
      expr = {
        session$setInputs("teal_modules-active_tab" = "module_1")
        testthat::expect_identical(
          module_summary_table(output, "module_1"),
          data.frame(
            "Data Name" = c("iris"),
            Obs = c("150/150"),
            check.names = FALSE
          )
        )
      }
    )
  })

  testthat::it("displays parent before child when join_keys are provided", {
    data <- teal.data::teal_data(
      parent = mtcars,
      child = data.frame(am = c(0, 1), test = c("a", "b"))
    )

    teal.data::join_keys(data) <- teal.data::join_keys(
      teal.data::join_key("parent", "child", keys = c("am"))
    )
    shiny::testServer(
      app = srv_teal,
      args = list(
        id = "test",
        data = data,
        modules = modules(module("module_1", server = function(id, data) data))
      ),
      expr = {
        session$setInputs("teal_modules-active_tab" = "module_1")
        session$flushReact()
        testthat::expect_identical(
          module_summary_table(output, "module_1")[["Data Name"]],
          c("parent", "child")
        )
      }
    )
  })

  testthat::it("displays subset of module$datanames if not sufficient", {
    data <- teal.data::teal_data(iris = iris, mtcars = mtcars)
    shiny::testServer(
      app = srv_teal,
      args = list(
        id = "test",
        data = data,
        modules = modules(module("module_1", server = function(id, data) data, datanames = c("iris", "iris2")))
      ),
      expr = {
        session$setInputs("teal_modules-active_tab" = "module_1")
        session$flushReact()
        testthat::expect_identical(
          module_summary_table(output, "module_1"),
          data.frame(
            "Data Name" = c("iris"),
            Obs = c("150/150"),
            check.names = FALSE
          )
        )
      }
    )
  })

  testthat::it("summary table displays MAE dataset added in transformators", {
    data <- within(teal.data::teal_data(), {
      iris <- iris
      mtcars <- mtcars
      foo <- identity
    })
    shiny::testServer(
      app = srv_teal,
      args = list(
        id = "test",
        data = data,
        modules = modules(module("module_1", server = function(id, data) data, datanames = "all", transformators = list(
          teal_transform_module(
            server = function(id, data) {
              reactive({
                within(data(), {
                  withr::with_package("MultiAssayExperiment", {
                    data("miniACC", package = "MultiAssayExperiment", envir = environment())
                  })
                })
              })
            }
          )
        )))
      ),
      expr = {
        # throws warning as data("miniACC") hasn't been detected as miniACC dependency
        suppressWarnings(session$setInputs("teal_modules-active_tab" = "module_1"))
        testthat::expect_equal(
          module_summary_table(output, "module_1"),
          data.frame(
            "Data Name" = c(
              "iris", "miniACC", "- RNASeq2GeneNorm", "- gistict",
              "- RPPAArray", "- Mutations", "- miRNASeqGene", "mtcars"
            ),
            Obs = c("150/150", "", "198", "198", "33", "97", "471", "32/32"),
            Subjects = c(NA_integer_, 92, 79, 90, 46, 90, 80, NA_integer_),
            check.names = FALSE
          )
        )
      }
    )
  })

  testthat::it("displays unsupported datasets", {
    data <- within(teal.data::teal_data(), {
      iris <- iris
      mtcars <- mtcars
      foo <- identity
    })
    shiny::testServer(
      app = srv_teal,
      args = list(
        id = "test",
        data = data,
        modules = modules(module("module_1", server = function(id, data) data, datanames = "all"))
      ),
      expr = {
        session$setInputs("teal_modules-active_tab" = "module_1")
        session$flushReact()
        testthat::expect_identical(
          module_summary_table(output, "module_1"),
          data.frame(
            "Data Name" = c("iris", "mtcars"),
            Obs = c("150/150", "32/32"),
            check.names = FALSE
          )
        )
      }
    )
  })
})

testthat::describe("srv_teal snapshot manager", {
  testthat::it("clicking reset button restores initial filters state when !module_specific", {
    shiny::testServer(
      app = srv_teal,
      args = list(
        id = "test",
        data = teal.data::teal_data(iris = iris, mtcars = mtcars),
        modules = modules(
          module("module_1", server = function(id, data) data),
          module("module_2", server = function(id, data) data)
        ),
        filter = teal_slices(
          teal_slice("iris", "Species"),
          teal_slice("mtcars", "cyl"),
          module_specific = FALSE
        )
      ),
      expr = {
        initial_slices <- slices_global$all_slices()
        session$setInputs("teal_modules-active_tab" = "module_1")
        slices_global$slices_set(teal_slices())
        session$flushReact()
        session$setInputs("snapshot_manager_panel-module-snapshot_reset" = TRUE)
        session$flushReact()
        testthat::expect_true(
          is_slices_equivalent(
            slices_global$all_slices(),
            initial_slices
          )
        )
        testthat::expect_true(
          is_slices_equivalent(
            slices_global$module_slices_api[["global_filters"]]$get_filter_state(),
            initial_slices,
            with_attrs = FALSE
          )
        )
      }
    )
  })

  testthat::it("clicking reset button restores initial filters with respect to mapping state when module_specific", {
    shiny::testServer(
      app = srv_teal,
      args = list(
        id = "test",
        data = teal.data::teal_data(iris = iris, mtcars = mtcars),
        modules = modules(
          module("module_1", server = function(id, data) data),
          module("module_2", server = function(id, data) data)
        ),
        filter = teal_slices(
          teal_slice("iris", "Species"),
          teal_slice("mtcars", "cyl"),
          mapping = list(module_1 = "iris Species", module_2 = "mtcars cyl"),
          module_specific = TRUE
        )
      ),
      expr = {
        initial_slices <- slices_global$all_slices()
        session$setInputs("teal_modules-active_tab" = "module_1")
        session$setInputs("teal_modules-active_tab" = "module_2")
        slices_global$slices_set(teal_slices())
        session$flushReact()
        session$setInputs("snapshot_manager_panel-module-snapshot_reset" = TRUE)
        session$flushReact()
        testthat::expect_true(
          is_slices_equivalent(
            slices_global$all_slices(),
            initial_slices
          )
        )
        testthat::expect_true(
          is_slices_equivalent(
            slices_global$module_slices_api[["module_1"]]$get_filter_state(),
            initial_slices[1],
            with_attrs = FALSE
          )
        )
        testthat::expect_true(
          is_slices_equivalent(
            slices_global$module_slices_api[["module_2"]]$get_filter_state(),
            initial_slices[2],
            with_attrs = FALSE
          )
        )
      }
    )
  })
})

testthat::describe("Datanames with special symbols", {
  testthat::it("are detected as datanames when defined as 'all'", {
    shiny::testServer(
      app = srv_teal,
      args = list(
        id = "test",
        data = teal.data::teal_data(
          iris = iris,
          `%a_pipe%` = function(lhs, rhs) paste(lhs, rhs)
        ),
        modules = modules(module("module_1", server = function(id, data) data)),
        filter = teal_slices(
          module_specific = TRUE
        )
      ),
      expr = {
        session$setInputs("teal_modules-active_tab" = "module_1")
        session$flushReact()

        testthat::expect_setequal(
          names(modules_output$module_1()()),
          c("iris", "%a_pipe%")
        )
      }
    )
  })

  testthat::it("are present in datanames when used in pre-processing code", {
    shiny::testServer(
      app = srv_teal,
      args = list(
        id = "test",
        data = within(
          teal.data::teal_data(),
          {
            iris <- iris
            mtcars <- mtcars
            `_a variable with spaces_` <- "new_column" # nolint: object_name.
            iris <- cbind(iris, data.frame(`_a variable with spaces_`))
          }
        ),
        modules = modules(
          module("module_1", server = function(id, data) data, datanames = c("iris", "_a variable with spaces_"))
        )
      ),
      expr = {
        session$setInputs("teal_modules-active_tab" = "module_1")
        session$flushReact()

        testthat::expect_setequal(
          names(modules_output$module_1()()),
          c("iris", "_a variable with spaces_")
        )
      }
    )
  })

  testthat::it("(when used as non-native pipe) are present in datanames in the pre-processing code", {
    shiny::testServer(
      app = srv_teal,
      args = list(
        id = "test",
        data = within(
          teal.data::teal_data(),
          {
            iris <- iris
            mtcars <- mtcars
            `%cbind%` <- function(lhs, rhs) cbind(lhs, rhs)
            iris <- iris %cbind% data.frame("new_column")
          }
        ),
        modules = modules(
          module("module_1", server = function(id, data) data, datanames = c("iris"))
        ),
        filter = teal_slices(
          module_specific = TRUE
        )
      ),
      expr = {
        session$setInputs("teal_modules-active_tab" = "module_1")
        session$flushReact()

        testthat::expect_contains(
          strsplit(
            x = teal.code::get_code(modules_output$module_1()()),
            split = "\n"
          )[[1]],
          c(
            "`%cbind%` <- function(lhs, rhs) cbind(lhs, rhs)",
            ".raw_data <- list2env(list(iris = iris))"
          )
        )
      }
    )
  })
})

testthat::describe("teal.data code with a function defined", {
  testthat::it("is fully reproducible", {
    shiny::testServer(
      app = srv_teal,
      args = list(
        id = "test",
        data = reactive(within(teal.data::teal_data(), {
          fun <- function(x) {
            y <- x + 1
            y + 3
          }
        })),
        modules = modules(module("module_1", server = function(id, data) data))
      ),
      expr = {
        session$setInputs("teal_modules-active_tab" = "module_1")
        session$flushReact()

        # Need to evaluate characters to preserve indentation
        local_env <- new.env(parent = .GlobalEnv)
        dat <- modules_output$module_1()()

        eval(
          parse(text = teal.code::get_code(dat)),
          envir = local_env
        )

        testthat::expect_identical(local_env$fun(1), 5)
        testthat::expect_identical(local_env$fun(1), dat[["fun"]](1))
      }
    )
  })

  testthat::it("has the correct code (with hash)", {
    shiny::testServer(
      app = srv_teal,
      args = list(
        id = "test",
        data = reactive(within(teal.data::teal_data(), {
          fun <- function(x) {
            y <- x + 1
            y + 3
          }
        })),
        modules = modules(module("module_1", server = function(id, data) data))
      ),
      expr = {
        session$setInputs("teal_modules-active_tab" = "module_1")
        session$flushReact()

        # Need to evaluate characters to preserve indentation
        local_env <- new.env(parent = .GlobalEnv)
        eval(
          parse(
            text = paste(
              sep = "\n",
              "fun <- function(x) {",
              "    y <- x + 1",
              "    y + 3",
              "}"
            )
          ),
          envir = local_env
        )
        local(hash <- rlang::hash(deparse1(fun)), envir = local_env)
        testthat::expect_setequal(
          trimws(strsplit(
            x = teal.code::get_code(modules_output$module_1()()),
            split = "\n"
          )[[1]]),
          c(
            "fun <- function(x) {",
            "y <- x + 1",
            "y + 3",
            "}",
            sprintf("stopifnot(rlang::hash(deparse1(fun)) == \"%s\") # @linksto fun", local_env$hash),
            ".raw_data <- list2env(list(fun = fun))",
            "lockEnvironment(.raw_data) # @linksto .raw_data"
          )
        )
      }
    )
  })
})