R/utils_manager.R

Defines functions upload_output upload_document evaluate_file

################################
####    Utilities Manager   ####
################################


#----    evaluate_file    ----
#' Evaluate File local and Google Drive Information
#'
#' @param file character indicating the path to the local file (or output)
#' @param gfile character indicating the name of a Google Drive file
#' @param gpath character indicating the path in Google Drive
#' @param shared_drive character. The name of a Google Drive shared drive
#'   (optional).
#' @param test character indicating whether to test no line in dribble ("none"),
#'   single line in dribble ("single") or both condition accepted ("both")
#'
#' @return a list with relevant information 
#'  - file - character indicating the path to the local file (or output)
#'  - file_info - list with file info returned from  get_file_info()
#'    function
#'  - gfile - character indicating the corrected gfile naem for the file
#'  - dribble_info - list with dribble info of the file and parent
#'    returned by get_dribble_info() function
#'  
#' @noRd
#'
#' @examples
#' # file
#' file <- "tests/testthat/test_files/examples/example-1.Rmd"
#' 
#' # output
#' file <- "tests/testthat/test_files/examples/example-1.pdf"
#' 
#' evaluate_file(file)
#' 

evaluate_file <- function(file, 
                          gfile = NULL,
                          gpath = "trackdown", 
                          shared_drive = NULL, 
                          test = c("none", "single", "both")){

  test <-  match.arg(test)
  
  # check local file exists and get file info
  check_file(file)
  file_info <- get_file_info(file = file)
  
  # set correct gfile
  gfile <- ifelse(is.null(gfile), yes = file_info$file_basename, no = gfile)
    
  # get dribble info
  dribble_info <- get_dribble_info(gfile = gfile,
                                   path = gpath, 
                                   shared_drive = shared_drive)
  
  # check there is no file (or a single file) with same name in drive
  check_dribble(dribble_info$file, gfile, test = test)
  
  return(list(file = file,
              file_info = file_info,
              gfile = gfile,
              dribble_info = dribble_info))
}

#----    upload_document    ----

#' Upload (or Update) a Document in Google Drive
#'
#' Internal function to upload (or update) a local file to Google Drive as a
#' plain text document. Local file information and Google Drive document
#' information and have to be provided. Option `hide_code` allows to
#' remove code chunks from the text document and option `update`
#' indicates whether to update file in Google Drive.
#'
#' @param file character. The path (without file extension) of a local `.Rmd`
#'   file.
#' @param file_info list with file info returned from get_file_info() function
#' @param gfile character. The name of a Google Drive file (defaults to local
#'   file name).
#' @param gpath character indicating the (sub)directory in Google Drive.
#' @param dribble_document A list with two dribble object regarding the gfile
#'   and the parent item.
#' @param hide_code logical value indicating whether to remove code from the
#'   text document (chunks and header). Placeholders of  type `"[[chunk-<name>]]"`
#'   are displayed instead.
#' @param update logical value indicating whether to update or upload the
#'   document.
#' @param rich_text (experimental) logical value (default is `TRUE`)
#'   indicating whether to upload to Google Docs a rich document (i.e.,
#'   important text that should not be changed is highlighted).
#' @param rich_text_par (experimental) argument used to pass a list with custom
#'   settings for rich_text.
#'
#' @return a dribble of the uploaded (or updated) document
#' @noRd
#'
#' @examples
#' file <- "tests/testthat/test_files/examples/example-1.Rmd"
#' file_info <- get_file_info(file)
#' gfile <- "example-1"
#' dribble_document <- get_dribble_info(gfile = gfile, path = "unit_tests/examples")
#' hide_code <- FALSE
#' upload_document(file, file_info, gfile, gpath = "trackdown/examples",
#'                 dribble_document, hide_code, update = TRUE)
#' 

upload_document <- function(file, file_info, 
                            gfile, gpath, dribble_document, 
                            hide_code, rich_text = TRUE, rich_text_par = NULL,
                            update = FALSE){
  #---- temp file ----
  # create .temp-file to upload
  temp_file <- file.path(file_info$path, 
                         paste0(".temp-", file_info$file_basename, ".txt"))
  file.copy(file, temp_file, overwrite = TRUE)
  
  # remove temp-file on exit
  on.exit(invisible(file.remove(temp_file)), add = TRUE)
  
  # read document lines
  document <-  readLines(temp_file, warn = FALSE)
  
  
  #---- hide code ----
  if(isTRUE(hide_code)){
    start_process("Removing code...")
    document <- hide_code(document = document,
                          file_info = file_info)
    finish_process(paste("Code removed from", emph_file(file_info$file_name)))
  }
  
  
  #---- upload document ----
  
  googledrive::local_drive_quiet() # suppress messages from googledrive
  
  # Format document to a single string
  document_oneline <- format_document(document, 
                                      file_info = file_info, 
                                      hide_code = hide_code)
  cat(document_oneline, file = temp_file)
  
  
  if(isTRUE(update)){
    start_process("Updating document with local changes to Google Drive...")
    
    # Update document
    res <- googledrive::drive_update(
      media = temp_file,
      file = dribble_document$file)
    
    finish_process(paste("Document updated at",
                         cli::col_blue(paste(gpath, gfile, sep = "/"))))
  } else {
    start_process("Uploading document to Google Drive...")
    
    # Upload document
    res <- googledrive::drive_upload(
      media = temp_file,
      path = dribble_document$parent,
      name = gfile,
      type = "document")
    
    finish_process(paste("Document uploaded at",
                         cli::col_blue(paste(gpath, gfile, sep = "/"))))
  }
  
  #----    rich_text    ----
  
  if(isTRUE(rich_text)){
    run_rich_text(text = document_oneline,
                  document_ID = res$id,
                  extension = file_info$extension,
                  rich_text_par = rich_text_par)
    
    finish_process("Rich text requests completed")
  }
  
  return(res)
}

#----    upload_output    ----

#' Upload (or Update) a Document in Google Drive
#'
#' Internal function to upload (or update) a local file to Google Drive as a
#' plain text document. Local file information and Google Drive document
#' information and have to be provided. Option `hide_code` allows to
#' remove code chunks from the text document and option `update`
#' indicates whether to update file in Google Drive.
#'
#' @param path_output character. The path (without file extension) of a local
#'   `.Rmd` file.
#' @param output_info list with file info returned from get_file_info() function
#' @param gfile_output character. The name of a Google Drive file (defaults to
#'   local file name).
#' @param gpath character indicating the (sub)directory in Google Drive.
#' @param dribble_output A list with two dribble object regarding the gfile and
#'   the parent item.
#' @param update logical value indicating whether to update or upload the
#'   document.
#' @param .response integer indicating automatic response in non interactive
#'   environment on whether to convert html to pdf (1 = Yes, 2 = No).
#' @param force logical value indicating whether to skip confirm check by user
#'   (default is `FALSE`).
#'
#' @return a dribble of the uploaded (or updated) output
#' @noRd
#'
#' @examples
#' # pdf
#' path_output <- "tests/testthat/test_files/examples/example_1.pdf"
#' 
#' # html
#' path_output <- "tests/testthat/test_files/example-1.html"
#' 
#' output_info <- get_file_info(path_output)
#' gfile_output <- "example_1-output"
#' dribble_output <- get_dribble_info(gfile = gfile_output, path = "trackdown/examples")
#' upload_output(path_output, output_info, gfile_output, gpath = "trackdown/examples",
#'               dribble_output, update = FALSE)
#'

upload_output <- function(path_output, output_info, 
                          gfile_output, gpath, dribble_output, 
                          update = FALSE, force = FALSE, .response = 2L){
  
  # check if the document is html 
  if (output_info$extension == "html"){
    
    # check if pagedown is available and if chrome is installed
    if(requireNamespace("pagedown", quietly = TRUE) && !does_error(pagedown::find_chrome())){
      
      if(interactive() && isFALSE(force)){
        html2pdf <- utils::menu(c("Yes", "No"),
                                title = paste("Transform HTML to PDF output before uploading?"))
      } else {
        html2pdf <- .response
      }
      
      if(html2pdf == 1L){
        start_process("Converting output to pdf...")
        
        # convert html to pdf
        path_output <- pagedown::chrome_print(path_output,
                                              output = file.path(output_info$path,
                                                                 paste0("temp-output-", output_info$file_basename, ".pdf")))
        output_info <- get_file_info(file = path_output)
        
        # remove temp-output on exit
        on.exit(invisible(file.remove(path_output)), add = TRUE)
      }
      
    } else {
      cli::cli_alert_info("Install package \"pagedown\" to automatically convert HTML to PDF output (Google Chrome is required)")
    }
  }
  
  googledrive::local_drive_quiet() # suppress messages from googledrive
  
  if(isTRUE(update)){
    start_process("Updating output with local changes to Google Drive...")
    
    # Update output
    res <- googledrive::drive_update(
      media = path_output,
      file = dribble_output$file)
    
    finish_process(paste("Output updated at",
                         cli::col_blue(paste(gpath, gfile_output, sep = "/"))))
  } else {
    start_process("Uploading output to Google Drive...")
    
    # Upload output
    res <- googledrive::drive_upload(
      media = path_output,
      path = dribble_output$parent,
      name = gfile_output,
      type = output_info$extension)
    
    finish_process(paste("Output uploaded at",
                         cli::col_blue(paste(gpath, gfile_output, sep = "/"))))
  }
  
  return(res)
}


#----
ekothe/trackdown documentation built on June 28, 2023, 4:57 p.m.