What's the cleanest way to implement a CRUD workflow in R Shiny?

Question

I'm trying to implement a CRUD workflow (Create/Read/Update/Delete) in Shiny to manage database records. It seems Shiny does not support this kind of workflow by default, so I'm wondering if there is a clean way to achieve this.

To narrow the scope of the question, I'm having a hard time adding static links to a table of records pointing to a specific tabPanel to edit the corresponding record.

Here is a mockup example to make it easier to troubleshoot this problem.

ui.R

library(shiny)

shinyUI(navbarPage("Example",
 tabPanel("Event List",
          sidebarLayout(
            sidebarPanel(list(
              p("If you click the link, it should go to the edit event panel."),
              p("But it's not...")
            ), align="left"),
            mainPanel(
              h3("Event List"),
              tableOutput('testTable'),
              dataTableOutput('events_table'),
              align="center"))),
 tabPanel("Edit Event", id='edit',
          sidebarLayout(
            sidebarPanel(
              uiOutput("choose_event_id"),
              align="center"),
            mainPanel()
          )),
 id='top'
))

server.R

library(shiny)

shinyServer(function(input, output, session) {

  output$choose_event_id  <- renderUI({
    selectizeInput("event_id", "Event", width='100%',
                   choices=c(1,2,3), selected=1)
  })

  output$testTable <- renderTable({
    require(xtable)
    table <- xtable(data.frame(A=1,B='<a href="LINK-HERE">test</a>'))
    table
  }, sanitize.text.function = function(x) x)

})

The LINK-HERE part is what I'm trying to figure out. tabPanels links change every time the app is restarted, so static links do not work in this case.

---

A second issue would be to pass the id of the record to be edited in the URL, but this could be left for a follow up question if necessary. I'll try to achieve this by using the approach from the answer of this SO question:

Shiny saving URL state subpages and tabs

Thanks in advance.

Answer 1

Try this. It uses DT and shinyjs

library(shiny)
library(shinyjs)
library(DT)

ui<- tagList(useShinyjs(),
tags$script(HTML("$(document).on('shiny:sessioninitialized', function(){
  var idz = [];
  var tags = document.getElementsByTagName('a');
 console.log(tags);
for (var i = 0; i < tags.length; i++) {
    idz.push(tags[i].hash);
    console.log(tags[i].hash); //console output for in browser debuggin'
                              }
 console.log(idz); // just checking again..
 Shiny.onInputChange('mydata', idz);
                          })")),

             navbarPage(title = "Example",

                   tabPanel("Event List",
                            sidebarLayout(
                              sidebarPanel(list(
                                p("If you click the link, it should go to the edit event panel."),
                                p("And now it does...")
                              ), align="left"),
                              mainPanel(
                                h3("Event List"),
                                DT::dataTableOutput('table'),
                                dataTableOutput('events_table'),
                                shiny::textOutput("mydata"),
                                align="center"))),
                   tabPanel("Edit Event", value='edit',
                            sidebarLayout(
                              sidebarPanel(
                                uiOutput("choose_event_id"),
                                align="center"),
                              mainPanel()
                            )),
                   id='top'
))




server<- shinyServer(function(input, output, session) {
  my_choices_list<- c("Dog", "Cat", "Fish")

  output$choose_event_id  <- renderUI({
    selectizeInput("event_id", "Event", width='100%',
                   choices=my_choices_list, selected=my_choices_list[1])
  })
  output$mydata<- renderPrint({
    tmp<- input$mydata
    tmp<- tmp[2:length(tmp)]
    tmp<- unlist(tmp)
    paste0("HREF value of other tab(s).... ",  tmp, collapse = ", ")
  })
  mylinks<- reactive({
    if(!is.null(input$mydata)){
      tmp<- input$mydata
      tmp<- tmp[2:length(tmp)] # All tabs except the first tab
      tmp
    }
  })

  output$table <- DT::renderDataTable({
    if(is.null(mylinks())){
      table<- data.frame(A=1, B=2)
    }
    if(!is.null(mylinks())){
      links_list<- paste0('<a href="', mylinks(),'" data-toggle="tab">test</a>')
      table<- DT::datatable(data.frame(A=my_choices_list, B=rep(links_list, length(my_choices_list))),rownames = FALSE, escape = FALSE,  selection = 'single', options = list(dom = 't'))
    }
    table

  })
 table_proxy = dataTableProxy('table')

  observeEvent(input$table_rows_selected, {
    cat("The selected Row is...", input$table_rows_selected, "\n")
    updateNavbarPage(session = session, inputId = "top", selected = "edit")
    shiny::updateSelectizeInput(session, inputId = "event_id", selected = my_choices_list[input$table_rows_selected])
    table_proxy %>% selectRows(NULL)
  })

})


shinyApp(ui = ui, server=server)

The code may need to be cleaned up a bit, but hopefully this at least gives you a start.