REDCapCAST/inst/shiny-examples/casting/server.R

server <- function(input, output, session) {
  require(REDCapCAST)

  # bslib::bs_themer()

  dat <- shiny::reactive({
    shiny::req(input$ds)

    output_staging$file <- "loaded"
    read_input(input$ds$datapath)
  })

  dd <- shiny::reactive({
    ds2dd_detailed(data = dat())
  })


  output$data.tbl <- shiny::renderTable({
    dd() |>
      purrr::pluck("data") |>
      head(20) |>
      dplyr::tibble()
  })

  output$meta.tbl <- shiny::renderTable({
    dd() |>
      purrr::pluck("meta") |>
      dplyr::tibble()
  })

  # Downloadable csv of dataset ----
  output$downloadData <- shiny::downloadHandler(
    filename = "data_ready.csv",
    content = function(file) {
      write.csv(purrr::pluck(dd(), "data"), file, row.names = FALSE,na = "")
    }
  )

  # Downloadable csv of data dictionary ----
  output$downloadMeta <- shiny::downloadHandler(
    filename = "datadictionary_ready.csv",
    content = function(file) {
      write.csv(purrr::pluck(dd(), "meta"), file, row.names = FALSE,na = "")
    }
  )

  # Downloadable .zip of instrument ----
  output$downloadInstrument <- shiny::downloadHandler(
    filename = paste0("REDCapCAST_instrument",Sys.Date(),".zip"),
    content = function(file) {
      export_redcap_instrument(purrr::pluck(dd(), "meta"), file)
    }
  )

  output_staging <- shiny::reactiveValues()
  output_staging$meta <- output_staging$data <- output_staging$file <- NA

  output$uploaded <- shiny::reactive({
    if (is.na(output_staging$file)) {
      "no"
    } else {
      "yes"
    }
  })

  shiny::outputOptions(output, "uploaded", suspendWhenHidden = FALSE)

  shiny::observeEvent(input$upload.meta,{  upload_meta()  })

  shiny::observeEvent(input$upload.data,{  upload_data()  })

  upload_meta <- function(){

    shiny::req(input$uri)

    shiny::req(input$api)

    output_staging$meta <- REDCapR::redcap_metadata_write(
      ds = purrr::pluck(dd(), "meta"),
      redcap_uri = input$uri,
      token = input$api
    )|> purrr::pluck("success")
  }

  upload_data <- function(){

    shiny::req(input$uri)

    shiny::req(input$api)

    output_staging$data <- REDCapR::redcap_write(
      ds = purrr::pluck(dd(), "data"),
      redcap_uri = input$uri,
      token = input$api
    ) |> purrr::pluck("success")
  }

  output$upload.meta.print <- renderText(output_staging$meta)

  output$upload.data.print <- renderText(output_staging$data)

}