Skip to content

Commit

Permalink
cleanup tests - remove ggplot2 examples
Browse files Browse the repository at this point in the history
  • Loading branch information
@m7pr
m7pr committed Nov 14, 2024
1 parent 717603d commit 31aa2d2
Showing 1 changed file with 61 additions and 243 deletions.
304 changes: 61 additions & 243 deletions tests/testthat/test-module_teal.R
View file
Original file line number Diff line number Diff line change
@@ -1,10 +1,5 @@
# comment: srv_teal is exported so the tests here are extensive and cover srv_data as well.
# testing of srv_data is not needed.


# utils -----------------------------------------------------------------------------------------------------------


module_summary_table <<- function(output, id) {
testthat::skip_if_not_installed("rvest")
table_id <- sprintf("teal_modules-%s-data_summary-table", id)
Expand All @@ -24,9 +19,6 @@ is_slices_equivalent <<- function(x, y, with_attrs = TRUE) {
identical(x_list, y_list)
}


# transformators ------------------------------------------------------------------------------------------------------

transform_list <<- list(
fail = teal_transform_module(
ui = function(id) NULL,
Expand Down Expand Up @@ -73,178 +65,6 @@ transform_list <<- list(
)
)


# decorators ------------------------------------------------------------------------------------------------------


gg_xlab_decorator <<- function(output_name) {
teal_transform_module(
ui = function(id) {
ns <- NS(id)
div(
textInput(ns("x_axis_title"), "X axis title", value = "x axis")
)
},
server = function(id, data) {
moduleServer(id, function(input, output, session) {
reactive({
req(data())
within(data(),
{
output_name <- output_name +
xlab(x_axis_title)
},
x_axis_title = input$x_axis_title,
output_name = as.name(output_name)
)
})
})
}
)
}

decorators <<- list(
static_decorator = teal_transform_module(
server = function(id, data) {
moduleServer(id, function(input, output, session) {
reactive({
req(data())
within(data(), {
plot <- plot +
ggtitle("This is title") +
xlab("x axis")
})
})
})
}
),
static_decorator_lang = teal_transform_module(
server = make_teal_transform_server(
expression(
plot <- plot +
ggtitle("This is title") +
xlab("x axis title")
)
)
),
interactive_decorator = teal_transform_module(
ui = function(id) {
ns <- NS(id)
div(
textInput(ns("x_axis_title"), "X axis title", value = "x axis")
)
},
server = function(id, data) {
moduleServer(id, function(input, output, session) {
reactive({
req(data())
within(data(),
{
plot <- plot +
ggtitle("This is title") +
xlab(x_axis_title)
},
x_axis_title = input$x_axis_title
)
})
})
}
),
interactive_decorator_lang = teal_transform_module(
ui = function(id) {
ns <- NS(id)
div(
textInput(ns("x_axis_title"), "X axis title", value = "x axis")
)
},
server = make_teal_transform_server(
expression(
plot <- plot +
ggtitle("This is title") +
xlab(x_axis_title)
)
)
),
gg_xlab_decorator = gg_xlab_decorator("plot"),
failing_decorator = teal_transform_module(
ui = function(id) {
ns <- NS(id)
div(
textInput(ns("x_axis_title"), "X axis title", value = "x axis")
)
},
server = function(id, data) {
moduleServer(id, function(input, output, session) {
reactive(stop("This is error"))
})
}
)
)

tm_decorated_plot <<- function(label = "module", transformators = list(), decorators = teal_transform_module()) {
module(
label = label,
ui = function(id, decorators) {
ns <- NS(id)
div(
selectInput(ns("dataname"), label = "select dataname", choices = NULL),
selectInput(ns("x"), label = "select x", choices = NULL),
selectInput(ns("y"), label = "select y", choices = NULL),
ui_teal_transform_data(ns("decorate"), transformators = decorators),
plotOutput(ns("plot")),
verbatimTextOutput(ns("text"))
)
},
server = function(id, data, decorators) {
moduleServer(id, function(input, output, session) {
observeEvent(data(), {
updateSelectInput(inputId = "dataname", choices = names(data()))
})

observeEvent(input$dataname, {
req(input$dataname)
updateSelectInput(inputId = "x", choices = colnames(data()[[input$dataname]]))
updateSelectInput(inputId = "y", choices = colnames(data()[[input$dataname]]))
})

q1 <- debounce(
reactive({
req(input$dataname, input$x, input$y)
within(data(),
{
plot <- ggplot2::ggplot(dataname, ggplot2::aes(x = x, y = y)) +
ggplot2::geom_point()
},
dataname = as.name(input$dataname),
x = as.name(input$x),
y = as.name(input$y)
)
}), 200
)

q2 <- srv_teal_transform_data("decorate", data = q1, transformators = decorators)

plot_r <- reactive({
req(q2())
q2()[["plot"]]
})

output$plot <- renderPlot(plot_r())
output$text <- renderText({
teal.code::get_code(req(q2()))
})
})
},
ui_args = list(decorators = decorators),
server_args = list(decorators = decorators)
)
}


# tests -----------------------------------------------------------------------------------------------------------



testthat::describe("srv_teal lockfile", {
testthat::it(paste0(
"creation process is invoked for teal.lockfile.mode = \"enabled\" ",
Expand Down Expand Up @@ -2055,110 +1875,108 @@ testthat::describe("srv_teal teal_module(s) transformator", {
)
})

testthat::it("shows the decorator ui when decorator has it", {
shiny::testServer(
app = srv_teal,
args = list(
id = "test",
data = teal.data::teal_data(iris = iris, mtcars = mtcars),
modules = modules(tm_decorated_plot("interactive", decorators = decorators[["interactive_decorator"]]))
),
expr = {
# TODO
}
)
})

testthat::it("applies the decorator ui changes when module has a decorator with ui", {
shiny::testServer(
app = srv_teal,
args = list(
id = "test",
data = teal.data::teal_data(iris = iris, mtcars = mtcars),
modules = modules(
tm_decorated_plot(
"interactive_decorator_lang",
decorators = decorators[["interactive_decorator_lang"]]
)
testthat::it("changes module output for a module with a static decorator", {
testthat::skip("TODO")
output_decorator <- teal_transform_module(
server = make_teal_transform_server(
expression(
object <- rev(object)
)
),
expr = {
# TODO
}
)
)
})

testthat::it("changes module output for a module with a static decorator", {
shiny::testServer(
app = srv_teal,
args = list(
id = "test",
data = teal.data::teal_data(iris = iris, mtcars = mtcars),
modules = modules(tm_decorated_plot("static_decorator", decorators = decorators[["static_decorator"]]))
modules = modules(example_module("module 1", decorators = output_decorator))
),
expr = {
# session$setInputs(`teal_modules-active_tab` = "static_decorator")
# testthat::expect_identical(modules_output$static_decorator()()[["plot"]], TODO)
# session$setInputs(`teal_modules-active_tab` = "module 1")
# testthat::expect_identical(modules_output$module_1()()[["object"]], TODO)
}
)
})

testthat::it("changes module output for a module with a static decorator that uses expression", {

testthat::it("changes module output for a module with a decorator that is a function of object name", {
testthat::skip("TODO")
output_decorator <- function(output_name) {
teal_transform_module(
ui = function(id) {
ns <- NS(id)
div(
textInput(ns("append_text"), "Append text", value = "random text")
)
},
server = function(id, data) {
moduleServer(id, function(input, output, session) {
reactive({
req(data())
within(data(),
{
output_name <- paste0(output_name, append_text)
},
append_text = input$append_text,
output_name = as.name(output_name)
)
})
})
}
)
}

shiny::testServer(
app = srv_teal,
args = list(
id = "test",
data = teal.data::teal_data(iris = iris, mtcars = mtcars),
modules = modules(
tm_decorated_plot(
"static_decorator_lang",
decorators = decorators[["static_decorator_lang"]]
)
)
modules = modules(example_module("module 1", decorators = output_decorator[['object']]))
),
expr = {
# TODO
}
)
})

testthat::it("changes module output for a module with a decorator that is a function of object name", {
shiny::testServer(
app = srv_teal,
args = list(
id = "test",
data = teal.data::teal_data(iris = iris, mtcars = mtcars),
modules = modules(
tm_decorated_plot(
"gg_xlab_decorator",
decorators = decorators[["gg_xlab_decorator"]]
)
testthat::it("changes module output for a module with a interactive decorator", {
testthat::skip("TODO")
output_decorator <- teal_transform_module(
ui = function(id) {
ns <- NS(id)
div(
textInput(ns("append_text"), "Append text", value = "random text")
)
),
expr = {
# TODO
},
server = function(id, data) {
moduleServer(id, function(input, output, session) {
reactive({
req(data())
within(data(),
{
object <- paste0(object, append_text)
},
append_text = input$append_text
)
})
})
}
)
})

testthat::it("shows failure message when module with decorator fails", {
shiny::testServer(
app = srv_teal,
args = list(
id = "test",
data = teal.data::teal_data(iris = iris, mtcars = mtcars),
modules = modules(
tm_decorated_plot(
"failing_decorator",
decorators = decorators[["failing_decorator"]]
)
)
modules = modules(example_module("module 1", decorators = output_decorator))
),
expr = {
# TODO
}
)
})

})

testthat::describe("srv_teal summary table", {
Expand Down

0 comments on commit 31aa2d2

Please sign in to comment.