Enable multiline comments in report previewer and focus on 'add card' comment box

[asbates]

This PR enables markdown rendering in the report previewer. Users can use markdown in report card comment boxes and it will display in the previewer. Note that markdown in comment boxes already renders correctly in the downloaded report. The change here ensures rendering in the previewer within an app.

Also sets the cursor to focus in the comment box when the add report card button is clicked.

Note the first comment in the issues shows a multiline comment not rendering correctly. However the syntax is off because for markdown, there needs to be a blank line between each comment line.

There are no tests for this PR because

1. for the cursor focus, there isn't really an easy way to test this.
2. testing report previewer rendering requires upgrading to testthat 3rd edition. It was discussed by the team that we shouldn't upgrade this repo without upgrading the others.

Fixes #71

Example usage.

library(shiny)
library(teal.reporter)
library(ggplot2)

ui <- fluidPage(
  # please, specify specific bootstrap version and theme
  theme = bslib::bs_theme(version = "4"),
  titlePanel(""),
  tabsetPanel(
    tabPanel(
      "main App",
      tags$br(),
      sidebarLayout(
        sidebarPanel(
          uiOutput("encoding")
        ),
        mainPanel(
          tabsetPanel(
            id = "tabs",
            tabPanel("Plot", plotOutput("dist_plot"))
          )
        )
      )
    ),
    ### REPORTER
    tabPanel(
      "Previewer",
      reporter_previewer_ui("prev")
    )
    ###
  )
)
server <- function(input, output, session) {
  output$encoding <- renderUI({
    tagList(
      ### REPORTER
      teal.reporter::simple_reporter_ui("simple_reporter"),
      ###
      if (input$tabs == "Plot") {
        sliderInput(
          "binwidth",
          "binwidth",
          min = 2,
          max = 10,
          value = 8
        )
      } else {
        NULL
      }
    )
  })
  plot <- reactive({
    req(input$binwidth)
    x <- mtcars$mpg
    ggplot2::ggplot(data = mtcars, ggplot2::aes(x = mpg)) +
      ggplot2::geom_histogram(binwidth = input$binwidth)
  })
  output$dist_plot <- renderPlot(plot())

  ### REPORTER
  reporter <- teal.reporter::Reporter$new()
  card_fun <- function(card = ReportCard$new(), comment) {
    if (input$tabs == "Plot") {
      card$set_name("Plot Module")
      card$append_text("My plot", "header2")
      card$append_plot(plot())
      card$append_text(
        paste(
          c(
            "x <- mtcars$mpg",
            "ggplot2::ggplot(data = mtcars, ggplot2::aes(x = mpg)) +",
            paste0("ggplot2::geom_histogram(binwidth = ", input$binwidth, ")")
          ),
          collapse = "\n"
        ),
        "verbatim"
      )
    }
    if (!comment == "") {
      card$append_text("Comment", "header3")
      card$append_text(comment)
    }
    card
  }
  teal.reporter::simple_reporter_srv("simple_reporter", reporter = reporter, card_fun = card_fun)
  teal.reporter::reporter_previewer_srv("prev", reporter)
  ###
}

shinyApp(ui = ui, server = server)

[github-actions[bot]]

Code Coverage Summary

Filename              Stmts    Miss  Cover    Missing
------------------  -------  ------  -------  --------------------------------------------------------------------
R/AddCardModule.R       130       0  100.00%
R/Archiver.R             25       0  100.00%
R/ContentBlock.R         16       0  100.00%
R/DownloadModule.R      169      43  74.56%   84-90, 159-164, 173-177, 180-184, 192-196, 199-203, 210-214, 217-221
R/FileBlock.R            13       0  100.00%
R/NewpageBlock.R          2       0  100.00%
R/PictureBlock.R         30       1  96.67%   15
R/Previewer.R           262      52  80.15%   164, 166-169, 174-180, 305-349
R/Renderer.R             54       4  92.59%   142, 144-145, 166
R/ReportCard.R           76       2  97.37%   211, 232
R/Reporter.R             96       1  98.96%   255
R/ResetModule.R          55       0  100.00%
R/SimpleReporter.R       24       0  100.00%
R/TableBlock.R            8       0  100.00%
R/TealReportCard.R       28       0  100.00%
R/TextBlock.R            13       0  100.00%
R/utils.R                 4       1  75.00%   7
R/yaml_utils.R           74       2  97.30%   65, 263
TOTAL                  1079     106  90.18%

Results for commit: b9ae4530582bf47b47dc41fd5e6dbfc13f43a14d

Minimum allowed coverage is 80%

:recycle: This comment has been updated with latest results

[github-actions[bot]]

Unit Tests Summary

    1 files    18 suites   10s :stopwatch: 193 tests 193 :heavy_check_mark: 0 :zzz: 0 :x: 280 runs  280 :heavy_check_mark: 0 :zzz: 0 :x:

Results for commit 47154f91.

:recycle: This comment has been updated with latest results.

[mhallal1]

@asbates What about simple text with line breaks as in the original issue?

[Polkas]

1. the render_text_block_preview function is overcomplicated
2. The jquery event Listener is to general about the element. It is good "shown.bs.modal" was used instead of "show.bs.modal". However what if there are two modals at the same time, is it possible?
3. lack of added additional tests, for the markdown and cursor updates. Both of them seem to be able to check with shiny::testServer.

Markdown

Example for the markdown::markdownToHTML function which convert markdown to HTML. THe markdown package is a RStudio tool and have only 2 dependencies. In my opinion the markdown package solution is more direct comapred to temp files and rmarkdown package.

library(shiny)

ui <- fluidPage(
  textAreaInput("markdown", "markdown"),
  uiOutput("HTMLtext")
)

server <- function(input, output, session) {
  output$HTMLtext <- renderUI({
      shiny::HTML(markdown::markdownToHTML(text = input$markdown, fragment.only = TRUE))
  })
}

shinyApp(ui, server)

other solution cloud be to use JavaScript library like https://github.com/showdownjs/showdown directly

[asbates]

@asbates What about simple text with line breaks as in the original issue?

For a test? Yes, that could work too. I'm hesitant about that as well because comparing to html in a string seems brittle to me. However, it can serve as a decent stop gap measure until we have snapshot testing enabled.

[Polkas]

@asbates Please compare the markdown and rmarkdown solutions with microbenchmark::microbenchmark We have to assume each could be run x100 and more times each session.

[asbates]

@asbates What about simple text with line breaks as in the original issue?

For a test? Yes, that could work too. I'm hesitant about that as well because comparing to html in a string seems brittle to me. However, it can serve as a decent stop gap measure until we have snapshot testing enabled.

@mhallal1 @polkas I've added a simple test case. I can add more and/or more complex cases if needed. But I really think snapshot testing is the way to go here, not checking HTML as a string.

[Polkas]

Answer to "However, I don't see how it's worth it to add markdown when we already depend on rmarkdown.", Current solution is highly inefficient.

markdown solution is x1000 quicker than rmarkdown one using median time. More than that 0.05 seconds for rmarkdown solution could easily sum to a few seconds as the function will be call many times.

render_text_block_preview <- function(block_content) {
  file <- tempfile()
  on.exit(rm(file))
  # need at least a title to prevent warnings
  header <- "---\ntitle: 'title'\n---\n"
  writeLines(paste0(header, block_content), file)
  html <- rmarkdown::render(
    file,
    output_format = "html_fragment",
    quiet = TRUE,
    params = list(title = "")
  )
  paste(readLines(html), collapse = "")
}

input_small = "Hello World!"
microbenchmark::microbenchmark(
  markdown::markdownToHTML(text = input_small, fragment.only = TRUE),
  render_text_block_preview(input_small),
  unit = "s"
)
#> Warning in microbenchmark::microbenchmark(markdown::markdownToHTML(text =
#> input_small, : less accurate nanosecond times to avoid potential integer
#> overflows
#> Unit: seconds
#>                                                                expr         min          lq         mean
#>  markdown::markdownToHTML(text = input_small, fragment.only = TRUE) 0.000036859 0.000044567 6.725435e-05
#>                             render_text_block_preview(input_small) 0.043106252 0.046016452 4.834861e-02
#>       median          uq        max neval
#> 0.000082041 0.000085772 0.00016974   100
#> 0.047061932 0.047592287 0.18996473   100

^{Created on 2022-10-25 with reprex v2.0.2}

[donyunardi]

@Polkas @asbates Thank you for separating markdown feature in different issue. We will need to check with PO to see if this is a desired feature.

[asbates]

@Polkas Bootstrap only allows one modal to be open at a time. . That's why we can use '#shiny-modal' as a selector. Although the id is repeated, the object is added and removed from the DOM so there is never more than 1 '#shiny-modal'.

From what I can determine, when an element is removed from the DOM any attached event listeners are removed. There is a caveat that there can't be a JS reference to that element. We never create a variable (el = $('#shiny-modal') so as far as I can tell the event listeners are removed when the modal is dismissed.

To be extra sure though, we can call $('#shiny-modal').off(...). If we call .off() immediately after our .on() call, there is not enough time for the modal to render and cursor to focus in the comment box. But, we can call .off() in a setTimeout() to allow for rendering time. A 5 second timeout does the trick. I've set the time out to a higher value so I can double check the listener gets destroyed.

What do you think about this setTimeout() approach?

[Polkas]

@donyunardi Yes, the issue separation was my proposition. I think the footer in the issue was a small trap, which suggests nice to have feature here. Thank you @asbates for a great research regarding bootstrap modal, I will double check it out now.

[Polkas]

@asbates please feel free to merge the PR now. Remember to edit commit messages, usually we leave one most important phrase and coauthors.

[asbates]

@asbates please feel free to merge the PR now. Remember to edit commit messages, usually we leave one most important phrase and coauthors.

I'm not sure what you mean in the second sentence here. Could we talk about it tomorrow after standup?

[Polkas]

@asbates

https://user-images.githubusercontent.com/10676545/199218562-316a1ca7-29a8-48c5-9944-d9671200990e.mov