R/golem_utils_server.R

In mcanigueral/testapp: A Shiny app test using {golem}

#' Inverted versions of in, is.null and is.na
#' 
#' @noRd
#' 
#' @examples
#' 1 %not_in% 1:10
#' not_null(NULL)
`%not_in%` <- Negate(`%in%`)

not_null <- Negate(is.null)

not_na <- Negate(is.na)

#' Removes the null from a vector
#' 
#' @noRd
#' 
#' @example 
#' drop_nulls(list(1, NULL, 2))
drop_nulls <- function(x){
  x[!sapply(x, is.null)]
}

#' If x is `NULL`, return y, otherwise return x
#' 
#' @param x,y Two elements to test, one potentially `NULL`
#' 
#' @noRd
#' 
#' @examples
#' NULL %||% 1
"%||%" <- function(x, y){
  if (is.null(x)) {
    y
  } else {
    x
  }
}

#' If x is `NA`, return y, otherwise return x
#' 
#' @param x,y Two elements to test, one potentially `NA`
#' 
#' @noRd
#' 
#' @examples
#' NA %||% 1
"%|NA|%" <- function(x, y){
  if (is.na(x)) {
    y
  } else {
    x
  }
}

#' Typing reactiveValues is too long
#' 
#' @inheritParams reactiveValues
#' @inheritParams reactiveValuesToList
#' 
#' @noRd
rv <- shiny::reactiveValues
rvtl <- shiny::reactiveValuesToList


#' Convert dataframe to timeseries
#' 
#' @param df Dataframe with first column as datetime vector
#' 
#' @importFrom xts xts
#' 
#' @noRd
#' 
df_to_ts <- function(df){
  xts::xts(df[-1], order.by = df[[1]])
}



#' Download file from github repository (public or private) through Personal Access Token (PAT)
#' 
#' @param repo repository name with {user}/{repo}
#' @param PAT Personal Access Token with repo acces
#' @param remote_path path to the file within the repository, including file name and extension.
#' @param local_path path to the save the file, including file name and extension.
#' @param fileext string with extension of the file to download. 
#' It can be ".xlsx", ".csv", ".yml", ".html", or ".css".
#' 
#' @importFrom httr authenticate GET content write_disk
#' @importFrom readxl read_excel
#' @importFrom config get
#' @importFrom readr read_csv
#' 
#' @noRd
download_github_file <- function(repo, PAT, remote_path, local_path=NULL, fileext=NULL) {
  
  if (is.null(fileext)) {
    fileext <- paste0(".", strsplit(remote_path, split = "[.]")[[1]][2])
  }
  
  if (is.null(local_path)) {
    local_path <- tempfile(fileext = fileext)
  }
  
  # Github authentication
  auth <-  httr::authenticate(PAT, "x-oauth-basic", "basic")
  
  # Get the URL of the file
  req <- httr::GET("https://api.github.com", 
                   path = paste0("repos/", repo, "/contents/", remote_path), 
                   auth)
  
  # Download and read file
  httr::GET(httr::content(req)$download_url, 
            auth, # authenticate using Github PAT
            httr::write_disk(path = local_path, overwrite = T)) # write result to disk
  
  if (fileext %in% c(".xlsx", ".xls")) {
    return(readxl::read_xlsx(local_path))
  } else if (fileext == ".yml") {
    return(config::get(file = local_path, config = Sys.getenv("R_CONFIG_ACTIVE", "default")))
  } else if (fileext == ".csv") { # Not excel CSV (csv2)
    return(readr::read_csv(local_path))
  } else if (fileext %in% c(".html", ".css")) {
    return(paste(readLines(local_path, encoding = "UTF-8"), collapse = "\n"))
  }
  
}


#' Download a file from Google Drive using and account and API Key
#'
#' @param drive_user Email from Google account with Google Drive API and Permissions
#' @param drive_path study case folder in Drive
#' @param drive_api_key Google Drive API Key
#' @param output_dir app directory
#'
#' @importFrom googledrive drive_auth drive_auth_configure drive_download drive_deauth
#' @importFrom utils unzip
download_drive_file <- function(drive_user, drive_path, drive_api_key, output_dir = "inst/app") {
  
  fileext <- paste0(".", strsplit(drive_path, split = "[.]")[[1]][2])
  local_path <- tempfile(fileext = fileext)
  
  # drive_auth(email = drive_user)
  # drive_deauth()
  # drive_auth_configure(email = drive_user, api_key = drive_api_key)
  drive_auth(email = drive_user, cache = ".secrets")
  drive_download(file = drive_path, overwrite = T, path = local_path)
  
  if (fileext == ".zip") {
    unzip(zipfile = local_path, exdir = output_dir)
    return(NULL)
  } else if (fileext == ".yml") {
    return(config::get(file = local_path, config = Sys.getenv("R_CONFIG_ACTIVE", "default")))
  } else if (fileext %in% c(".xlsx", ".xls")) {
    return(readxl::read_xlsx(local_path))
  } else if (fileext == ".csv") { # Not Excel CSV (csv2)
    return(readr::read_csv(local_path))
  } else if (fileext %in% c(".html", ".css")) {
    return(paste(readLines(local_path, encoding = "UTF-8"), collapse = "\n"))
  } 
  
}

#' Download study case data folder as zip
#'
#' @param drive_user Email from Google account with Google Drive API and Permissions
#' @param drive_path study case folder in Drive
#' @param drive_api_key Google Drive API Key
#' @param output_dir app directory
#'
download_client_data <- function(drive_user, drive_path, drive_api_key, output_dir = "inst/app") {
  drive_path_folders <- strsplit(drive_path, "/")[[1]]
  drive_zip_path <- paste0(drive_path, "/", drive_path_folders[length(drive_path_folders)], ".zip")
  
  download_drive_file(
    drive_user = drive_user, drive_path = drive_zip_path, 
    drive_api_key = drive_api_key, output_dir = output_dir
  )
}