R/module_csv.R

Defines functions prepare_full_path_table csvFile get_file_info_files csvFileUI

# csvFileUI --------------------------------------------------------------------

#' @importFrom shiny NS tagList selectInput
#' @keywords internal
csvFileUI <- function(id, path_database)
{
  ns <- shiny::NS(id)
  
  shiny::tagList(
    shiny::selectInput(
      inputId = ns("file"), 
      label = "Load saved paths from",
      choices = c(
        get_file_info_files(path_database),
        get_available_database_entries()
      )
    )
  )
}

# get_file_info_files ----------------------------------------------------------

#' @importFrom kwb.utils removeExtension multiSubstitute
#' @importFrom stats setNames
#' @keywords internal
get_file_info_files <- function(path_database)
{
  files <- c(
    dir_or_stop(extdata_file(), "^example_file_info.*\\.csv$"),
    dir_or_stop(path_database, "\\.csv$")
  )

  # Give user friendly labels to the files to appear in the dropdown list 
  file_labels <- kwb.utils::removeExtension(basename(files))
  
  replacements <- list(
    "^path-info(-ps-1)?_" = "",
    "(\\d{2})_\\d{4}" = "\\2"
  )

  stats::setNames(files, kwb.utils::multiSubstitute(file_labels, replacements))
}

# csvFile ----------------------------------------------------------------------

#' @importFrom shiny reactive
#' @importFrom kwb.utils selectColumns
#' @importFrom pathlist pathlist hide_server
#' @keywords internal
csvFile <- function(input, output, session, read_function)
{
  db_split_pattern <- "\\s*\\|\\s*"
  
  # Path to CSV file
  csv_file <- shiny::reactive({
    input$file
  })
  
  # Path to RDS file in the same folder
  rds_file <- shiny::reactive({
    if (grepl("^db", csv_file())) {
      file.path(
        get_global("path_database"),
        paste0(gsub(db_split_pattern, "_", csv_file()), ".rds")
      )
    } else {
      gsub("\\.csv$", ".rds", csv_file())
    }
  })
  
  # Does the RDS file already exist?  
  rds_file_exists <- shiny::reactive({
    file.exists(rds_file())
  })
  
  raw_content <- shiny::reactive({
    
    if (rds_file_exists()) {
      return(NULL)
    }
      
    x <- run_with_modal(
      text = paste("Reading", basename(csv_file())), 
      expr = {
        if (grepl("^db", csv_file())) {
          date_key <- strsplit(csv_file(), db_split_pattern)[[1]][-1]
          get_path_data_from_database(date_key[1], date_key[2])
        } else {
          read_file_paths(csv_file())
        }
      }
    )
    
    kwb.utils::selectColumns(
      x = normalise_column_names(x), 
      columns = c("path", "type", "size", "modified")
    )
  })
  
  rds_content <- shiny::reactive({
    
    if (! rds_file_exists()) {
      return(NULL)
    }
      
    run_with_modal(
      text = paste("Loading", basename(rds_file())),
      expr = readRDS(rds_file())
    )
  })
  
  path_list <- shiny::reactive({
    
    if (! is.null(rds_content())) {
      return(rds_content()$path_list)
    }
    
    run_with_modal(
      text = "Providing table data",
      expr = pathlist::hide_server(pathlist::pathlist(
        paths = raw_content()$path, 
        data = kwb.utils::selectColumns(
          raw_content(), c("type", "size", "modified")
        )
      ))
    )
  })
  
  content <- shiny::reactive({
    
    if (! is.null(rds_content())) {
      return(rds_content()$content)
    }
    
    x <- prepare_full_path_table(x = raw_content(), pl = path_list())
    
    content <- structure(x, root = path_list()@root)
    
    rds_content <- list(content = content, path_list = path_list())
    
    run_with_modal(
      text = paste("Caching data in", basename(rds_file())),
      expr = saveRDS(rds_content, file = rds_file())
    )
    
    content
  })
  
  list(file = csv_file, content = content, path_list = path_list)
}

# prepare_full_path_table ------------------------------------------------------

#' @importFrom kwb.utils fileExtension moveColumnsToFront removeColumns 
#' @importFrom kwb.utils selectColumns
#' @importFrom pathlist depth filename folder toplevel
#' @keywords internal
prepare_full_path_table <- function(x, pl)
{
  # Convert column "modified" to POSIXct
  timestamps <- kwb.utils::selectColumns(x, "modified")
  x$modified <- as.Date(as.POSIXct(timestamps, "%Y-%m-%dT%H:%M:%S", tz = "UTC"))

  # Provide/format columns "size", "toplevel", "folder", "filename"  
  #x$size <- round(x$size, 6)
  x$toplevel <- factor(pathlist::toplevel(pl))
  x$folder <- pathlist::folder(pl)
  x$filename <- pathlist::filename(pl)

  # Provide column "extension"  
  x$extension <- ""
  is_file <- x$type == "file"
  x$extension[is_file] <- kwb.utils::fileExtension(x$filename[is_file])
  x$extension <- factor(x$extension)

  # Provide column "depth"  
  x$depth <- pathlist::depth(pl)

  # Remove column "path" and move main columns to the left
  x <- kwb.utils::removeColumns(x, "path")
  main_columns <- c("toplevel", "folder", "filename", "extension")
  kwb.utils::moveColumnsToFront(x, main_columns)
}
KWB-R/fakin.path.app documentation built on Nov. 25, 2020, 10:20 p.m.