R/shiny_app_server.R

Defines functions shiny_app_server

Documented in shiny_app_server

#' noticeboard app server function
#'
#' @param input provided by shiny
#' @param output provided by shiny
#'
#' @import readr
#' @import dplyr
#' @import purrr
#' @import rvest
#' @import shiny
shiny_app_server <- function(input, output) {
  
  package_data <- read_csv("data/packages.csv")
  
  issue_table <- reactiveVal()
  
  observeEvent(input$search, {
    
    req(input$label_choice!="")
    
    urls <- input$label_choice
    print(urls)
    print("reading URLs")
    res <- purrr::map(urls, read_url)
    names(res) <- purrr::map_chr(urls, extract_repo_name)
    print("extracting issues")
    issues <- purrr::map_df(res, get_issues)
    print("creating table")
    issue_tbl <- get_issue_tbl(issues)
    print(issue_tbl)
    issue_table(issue_tbl)
    
  })
  
  output$package_choices <- renderUI({
    
    selectizeInput(
      "package_choice",
      "Select Packages",
      choices = unique(package_data$package),
      multiple = TRUE
    )
  })
  
  lbl_choices <- reactive({
    label_table <- package_data %>%
      filter(package %in% input$package_choice) %>%
      mutate(name = paste(package, ": ", label, sep = "")) 
    
    choices <- label_table$url
    names(choices) <- label_table$name
    choices
    
  })
  
  output$label_choices <- renderUI({
    req(input$package_choice)
    selectizeInput("label_choice", "Select Labels",   choices = lbl_choices(),
      multiple = TRUE
    )
  })
  
  output$packageTable <- renderDataTable({
    validate(
      need(
        input$search, "Select packages and tags to show issues"
      )
    )
    issue_table()
    }, escape = FALSE)
}
thisisnic/noticeboard documentation built on Nov. 7, 2018, 12:48 a.m.