R/data_module.R

In spada: A 'shiny' Package for Data Analysis

# ui --------------------------------------------------------------------------
data_ui <- function(id) {
  ns <- NS(id)

  card(
    card_body(
      selectInput(
        ns('sel_dt'),
        'Select a dataset',
        choices = NULL
      ),
      textInput(ns('txt_new_name'), 'New name'),
      layout_column_wrap(
        btn_task(ns('btn_new_name'), 'Rename dataset', icon('file-signature')),
        btn_task(ns('btn_active'), 'Make dataset Active', icon('check')),
        btn_task(ns('btn_copy_dt'), 'Copy dataset', icon('copy')),
        btn_task(ns('btn_del_dt'), 'Delete dataset', icon('trash-can'))
      )
    )
  )
}

# server ----------------------------------------------------------------------
data_server <- function(id) {
  moduleServer(id, function(input, output, session) {
	  ns <- session$ns

	  # update datasets input ---------------------------------------------------
	  observe({
	    req(session$userData$dt_names(), session$userData$dt$act_name)

	    choices <- c(
	      session$userData$dt$act_name,
	      setdiff(session$userData$dt_names(), session$userData$dt$act_name)
	    )

	    updateSelectInput(
	      session,
	      'sel_dt',
	      choices  = choices,
	      selected = session$userData$dt$act_name
	    )
	  })

	  # make active dataset event --------------
	  observe({
	    req(input$sel_dt)
	    session$userData$dt$act_name <- input$sel_dt
	    session$userData$dt$bkp0 <- copy(get_act_dt(session))
	    session$userData$dt$bkp <- NULL
	    msg(paste('Dataset', session$userData$dt$act_name, 'is the active one'))
	    updateTextInput(session, 'txt_new_name', value = '')
	  }) |> bindEvent(input$btn_active)

	  # rename dataset event -------------------
	  observe({
	    if(!is_name_available(input$txt_new_name, session$userData$dt_names())){
	      msg_error('New name is not valid or already in use')
	    } else {
	      names(session$userData$dt$dt)[session$userData$dt_names() == input$sel_dt] <- input$txt_new_name
	      # update active dataset if necessary
	      if(session$userData$dt$act_name == input$sel_dt){
	        session$userData$dt$act_name <- input$txt_new_name
	      }
	      # update metadata names
	      names(session$userData$dt$meta)[names(session$userData$dt$meta) == input$sel_dt] <- input$txt_new_name

	      msg('New name applied')
	      updateTextInput(session, 'txt_new_name', value = '')
	    }
	  }) |> bindEvent(input$btn_new_name)

	  # copy dataset event ---------------------
	  observe({
	    if(!is_name_available(input$txt_new_name, session$userData$dt_names())){
	      msg_error('New name is not valid or already in use')
	    } else {
	      session$userData$dt$dt[[input$txt_new_name]] <- session$userData$dt$dt[[input$sel_dt]]
	      # update metadata
	      session$userData$dt$meta[[input$txt_new_name]] <- session$userData$dt$meta[[input$sel_dt]]
	      gc()

	      msg(paste('Dataset', input$txt_new_name, 'created'))

	      updateTextInput(session, 'txt_new_name', value = '')
	    }
	  }) |> bindEvent(input$btn_copy_dt)

	  # delete dataset event -------------------
	  observe({
	    if(session$userData$dt$act_name == input$sel_dt){
	      msg_error('You can not delete the active dataset')
	    } else {
	      session$userData$dt$dt[[input$sel_dt]] <- NULL

	      # delete metadata
	      session$userData$dt$meta[[input$sel_dt]] <- NULL
	      gc()
	      msg(paste('Dataset', input$sel_dt, 'deleted'))

	      updateTextInput(session, 'txt_new_name', value = '')
	    }
	  }) |> bindEvent(input$btn_del_dt)

  })
}