ddl alternative

[chlebowa]

ddl implementation alternative to #161 .
Complemented by this PR.

In order to simplify the user (app dev) experience, I tried to streamline the logic.

In order to create a ddl connector module, one has to:

1. use input_template to create the module: enumerate input widgets
2. provide a function, on_submit, to be run when "submit" button is clicked; function takes input values wrapped in a list called input and body refers to input values with input$<value> or input[["<value>"]]
3. optionally provide mask for input values that will be used in code of resulting tdata object
4. specify names of data sets for compatibility with teal (I don't like it)
5. optionally specify join keys as one would previously, for compatibility with teal; defaults to empty teal.data::join_keys()

When inputs are submitted, on_submit is passed to a function that extracts the body, substitutes input placeholders with input values and evaluates the code to obtain data sets in a separate environment. Then it replaces the input values in the code with ones provided in mask (if any) and uses the environment and the masked code to create tdata.

Much like in the solution proposed on branch refactor, the user provides code to obtain data sets and replacements for input values, and data is created in separate environment, which is then used to create tdata with masked code.

Unlike that solution, the user specifies everything in one place, rather than having to define module ui, module server that runs a post-processing function, the post-processing function itself, etc. This is easier to understand for me.
Another difference is that the user provides code as code with input$ references, not text with glue syntax ({ value }). This is done move focus to masking rather than have the user think about "online" and "offline" arguments. It also uses pure base R.

MOCK DATABASE CONNECTION

pullme <- function(username, password) {
  if (username == "user" && password == "pass") {
    message("connection established")
  } else {
    stop("invalid credentials")
  }
}
closeme <- function() {
  message("connection closed")
}

MODULE DEFINITION

library(shiny)

thefun <- function(input) {
  on.exit(try(closeme()))
  pullme(username = input$user, password = input$pass)
  adsl <- scda::synthetic_cdisc_data('latest')$adsl
  adtte <- scda::synthetic_cdisc_data('latest')$adtte
}
themask <- list(
  user = quote(askpass("who are you?")),
  pass = quote(askpass("password please"))
)
module <- input_template(
  on_submit = thefun,
  mask = themask,
  datanames = c("adsl", "adtte"),
  textInput("user", "username", value = "user", placeholder = "who goes there?"),
  passwordInput("pass", "password", value = "pass", placeholder = "friend or foe?"),
  actionButton("submit", "get it")
)

AN APP

devtools::load_all("../teal.slice")
devtools::load_all("../teal")
devtools::load_all(".")

ui <- fluidPage(
  tagList(
    module$ui("id"),
    uiOutput("val")
  )
)
server <- function(input, output, session) {
  tdata <- module$server("id")
  output[["value"]] <- renderPrint({
    tdata()
  })
  output[["code"]] <- renderPrint({
    cat(teal.code::get_code(tdata()), sep = "\n")
  })
  output[["val"]] <- renderUI({
    req(tdata())
    tagList(
      verbatimTextOutput("value"),
      verbatimTextOutput("code")
    )
  })
}
if (interactive()) shinyApp(ui, server)

A TEAL APP

funny_module <- function (label = "Filter states", datanames = "all") {
  checkmate::assert_string(label)
  module(
    label = label,
    datanames = datanames,
    ui = function(id, ...) {
      ns <- NS(id)
      div(
        h2("The following filter calls are generated:"),
        verbatimTextOutput(ns("filter_states")),
        verbatimTextOutput(ns("filter_calls")),
        actionButton(ns("reset"), "reset_to_default")
      )
    },
    server = function(input, output, session, data, filter_panel_api) {
      checkmate::assert_class(data, "tdata")
      observeEvent(input$reset, set_filter_state(filter_panel_api, default_filters))
      output$filter_states <-  renderPrint({
        logger::log_trace("rendering text1")
        filter_panel_api %>% get_filter_state()
      })
      output$filter_calls <- renderText({
        logger::log_trace("rendering text2")
        attr(data, "code")()
      })
    }
  )
}

devtools::load_all("../teal.slice")
devtools::load_all("../teal")
devtools::load_all(".")

app <- init(
  data = module,
  modules = modules(
    funny_module("funny1"),
    funny_module("funny2", datanames = "adtte") # will limit datanames to ADTTE and ADSL (parent)
  )
)
shinyApp(app$ui, app$server)

[m7pr]

Suggested change

	#' When clicked, the `on_submit` function will be run.
	#' When clicked, `on_submit` function will run.

[m7pr]

Suggested change

	#' `on_submit` must take one argument called `inputs`,
	#' which will be a list of all input elements defined in the UI function except `"submit"`.
	#' `on_submit` takes one argument called `inputs`,
	#' which is a list of all input elements defined in the UI function, except `"submit"`.

[m7pr]

Suggested change

	#' The function body must contain all code necessary to obtain the desired data sets and nothing else.
	#' `on_submit` body should contain the code necessary to obtain the desired datasets and nothing else.

[m7pr]

Suggested change

	#' The `mask` argument can be used to mask input values used as arguments in the recorded code.
	#' The `mask` argument can be used to mask input values used as arguments in the recorded code. So that sensitive parts of code (like password or username) are substituted with `mask`ed values.

[m7pr]

Suggested change

	#' Input elements will be put in a div of class `connector-input`.
	#' Input elements will be put in a `connector-input` div.

[m7pr]

Suggested change

	#' @param mask optional list specifying how to mask the code run by `on_submit`, see `Details`
	#' @param mask an optional list specifying how to mask the code run by `on_submit`, see `Details`

[m7pr]

Suggested change

	#' @return A`reactive` expression returning a `tdata` object.
	#' @return A `reactive` expression returning a `tdata` object.

[m7pr]

Suggested change

	.var.name = "The \"submit\" element has class \"action-button\"."
	.var.name = "The \"submit\" element class: \"action-button\"."

[m7pr]

Hey @chlebowa I can't give any feedback to the code, as it's extremely condensed, clean and contains a lot of advanced tricks that reduces the complexity of the implementation. As always, a solid thorough work!

When it comes to the interface and user experience, I prefer this approach than #161 as I do see benefits of having everything in one place (input_template). This is very clear and short in terms of user specification and usage. It also gives a very direct and simple interface to actions happening on on_submit action and objects getting masked in the final output. And we don't need to deal with glue (yuk!).

You have my axe!

A small question: is there a way to use input_template as a welcome-popup that prevents data beoing loaded into the app before you accept a message appearing over a submit buton? So that we could solve this insightsengineering/teal#812

module <- input_template(
  h5('Below is a consens statement, that you need to accept before using the app. Do you accept?')
  actionButton("submit", "Accept"),
  on_submit = function(input) {
    # before on_submit data is NULL
    data <- pull(input$data) # ??
  }
)

[chlebowa]

I just pushed a major overhaul of roxygen docs, which should have been there from the beginning but slipped my mind during the multiple rewrites this file has seen ober the last two weeks. Sorry for the inconvenience and thank you @m7pr for bringing it to my attention.

[m7pr]

@chlebowa I would make sure those regexes work on all platforms. Looks like system specific?

[chlebowa]

As far as I know this is just R-specific, it looks a little weird because every slash has to be escaped. \w and backtracing are widely recognized.

[m7pr]

coolio

[averissimo]

There may be some edge cases where users use purrr::plucK(input, "something") or something else.

[chlebowa]

True, get, for instance. I'm not sure we have to worry about it, considering people mosty use $.

Now that I think about it, some NSE tricks would probably go unnoticed 🤔

[chlebowa]

A small question: is there a way to use input_template as a welcome-popup that prevents data beoing loaded into the app before you accept a message appearing over a submit buton? So that we could solve this insightsengineering/teal#812

I think that issue is about a popup on the whole app, regardless of whether the data is remote or local, so ddl would not reliably solve it.

[chlebowa]

Update: this version of ddl can now be used in a teal app 🎉
Unfortunately, some new arguments had to be added to input_template but there is nothing I can do about it for now.

I wonder what to do with errors raised by the user-provided code. Currently they are intercepted and passed to validate calls but they can still be lost before the user has a chance to see them. Compare the normal app to the teal one.
A solution would be to run the code in a qenv (or tdata) to take advantage of the qenv.error class to propagate errors to app outputs.

Requires teal branch alternative@refactor@main. staged.dependencies should handle it but one never knows.

[gogonzo]

We need a way to change code_masked when creating tdata object

Suggested change

	new_tdata(as.list(env), code = as.expression(code_masked), keys = join_keys)
	new_tdata(as.list(env), code = as.expression(code_masked), keys = join_keys)

There is a case where in the interactive session one can use login() function which opens a dialog, while for shiny session authentication is handled by the module and no login() function is used. It means that initial code_masked looks like this

data <- connection_package::read_data(...)

and returned should look like:

connection_package::login()
data <- connection_package::read_data(...)

[gogonzo]

We need a possibility to specify this server. For example to control hierarchical inputs.

Suggested change

	server <- function(id) {
	moduleServer(id, function(input, output, session) {
	result <- eventReactive(input[["submit"]], {
	inputs <- sapply(setdiff(inputIds, "submit"), function(x) input[[x]], simplify = FALSE)
	tryCatch(
	do.call(tracked_request, list(inputs)),
	error = function(e) validate(need(FALSE, sprintf("Error: %s", e$message)))
	)
	})
	result
	})
	server <- function(id) {
	moduleServer(id, function(input, output, session) {
	result <- eventReactive(input[["submit"]], {
	inputs <- sapply(setdiff(inputIds, "submit"), function(x) input[[x]], simplify = FALSE)
	tryCatch(
	do.call(tracked_request, list(inputs)),
	error = function(e) validate(need(FALSE, sprintf("Error: %s", e$message)))
	)
	})
	result
	})

[gogonzo]

Having just input_template without option to specify server limits possibilities. Besides, I like argument name on_submit but I'm indifferent whether it's a call, character or a function. The biggest issue I have with this approach is that call which creates a tdata is not open for modifications (like postprocess_fun in my PR) - this limits potential use cases.