R/shinyFilesSupportFunctions.R

In moj-analytical-services/s3browser: A R Studio Addin that allows you to browse the files you have access to in S3

#' Adds the content of www to sF/
#'
#' @importFrom shiny addResourcePath
#'
#' @noRd
#'
.onLoad <- function(...) {
  shiny::addResourcePath('sF', system.file('www', package='s3browser'))
}


#' Get a list of available volumes
#'
#' This function is intended as an input to the roots parameter in
#' \code{\link{fileGetter}} and \code{\link{shinyFileChoose}}. It returns a
#' function that returns a named vector of available volumes on the system. This
#' construction makes it dynamic so that a shinyFiles instance reflects new
#' volumes as they get added (e.g. usb drives). The function takes a single
#' argument giving names of volumes the developer wants removed from the return
#' value.
#'
#' @details
#' The function is OS specific and looks for volumes/drives in different places
#' depending on the system on which shiny is running.
#' \describe{
#'  \item{Windows}{Returns all drives mapped to a letter}
#'  \item{Mac OSX}{Looks in /Volumes/ and lists the directories therein}
#'  \item{Linux}{Returns the system root}
#' }
#' If the function does not recognize the system under which it is running it
#' will throw an error
#'
#' @param exclude A vector of volume names to be excluded from the return value
#'
#' @return A function returning a named vector of available volumes
#'
#'
#'
getVolumes <- function(exclude) {
  if(missing(exclude)) exclude <- NULL

  function() {
    osSystem <- Sys.info()['sysname']
    if (osSystem == 'Darwin') {
      volumes <- list.files('/Volumes/', full.names=T)
      names(volumes) <- basename(volumes)
    } else if (osSystem == 'Linux') {
      volumes <- c('Computer'='/')
      media <- list.files('/media/', full.names=T)
      names(media) <- basename(media)
      volumes <- c(volumes, media)
    } else if (osSystem == 'Windows') {
      volumes <- system('wmic logicaldisk get Caption', intern=T)
      volumes <- sub(' *\\r$', '', volumes)
      keep <- !tolower(volumes) %in% c('caption', '')
      volumes <- volumes[keep]
      volNames <- system('wmic logicaldisk get VolumeName', intern=T)
      volNames <- sub(' *\\r$', '', volNames)
      volNames <- volNames[keep]
      volNames <- paste0(volNames, ifelse(volNames == "", "", " "))
      volNames <- paste0(volNames, '(', volumes, ')')
      names(volumes) <- volNames
    } else {
      stop('unsupported OS')
    }
    if (!is.null(exclude)) {
      volumes <- volumes[!names(volumes) %in% exclude]
    }
    volumes
  }
}

getSession <- function() {
  session <- shiny::getDefaultReactiveDomain()

  if (is.null(session)) {
    stop(paste(
      "could not find the Shiny session object. This usually happens when a",
      "shinyjs function is called from a context that wasn't set up by a Shiny session."
    ))
  }

  session
}